{============================================================================} { 3 D S P I N - O - M A T I C (c) 1998 by Chris Gahan Description: This program loads a 3-dimensional mesh object (as used in 3DStudio) and displays it to the screen. It then spins it 'round and 'round, automatically or under user control. } {============================================================================} { COMPILER DIRECTIVES } {============================================================================} {$N+,G+} { This enables hardware floating point calculations. If your processor does not have an 80x87 math coprocessor, set this field to N- and E+ to emmulate the 80x87 processor. $G+ enables 286 instructions. If you are in the Turbo Pascal environment, enable these two settings under Options/Compiler... } {$M 16000, 200000, 500000} { Stack = 16k, Min heap = 200k, Max heap = 500k. If not enough conventional memory is available to run the program, try compiling it with Borland Pascal 7.0 (in protected mode). } {============================================================================} { INCLUDED UNITS } {============================================================================} uses Crt, DOS; {============================================================================} { CONSTANT VALUES } {============================================================================} const version = '1.3'; { Current program version number. } compdate = 'January 27, 1999'; { Last compile date. } XMAX = 320; { Screen's maximum X resolution. } YMAX = 200; { Screen's maximum Y resolution. } XMID = XMAX div 2; { The middle of the screen. } YMID = YMAX div 2; PROJECTION_RATIO = -2.0; XSCALE = 0.8 * PROJECTION_RATIO * XMID; YSCALE = -1.0 * PROJECTION_RATIO * YMID; screen : word = $A000; { Memory address of the video screen. } minmem = 5000; { Keep a minimum of 5k RAM free. } { Pregenerated Sin and Cos tables. Get the values by referencing SinVal[angle] or CosVal[angle]. The Sin/Cos values are of "single" precision. Tables created using GenTables.PAS by Chris Gahan. They're used to speed up the rotation Math which uses Sin/Cos quite a bit. } SinVal : array[0..360] of single = ( 0.00000000000000E+0000, 1.74524057656527E-0002, 3.48994955420494E-0002, 5.23359552025795E-0002, 6.97564706206322E-0002, 8.71557444334030E-0002, 1.04528464376926E-0001, 1.21869340538979E-0001, 1.39173105359077E-0001, 1.56434461474419E-0001, 1.73648178577423E-0001, 1.90808996558189E-0001, 2.07911685109138E-0001, 2.24951058626175E-0001, 2.41921901702881E-0001, 2.58819043636322E-0001, 2.75637358427048E-0001, 2.92371690273285E-0001, 3.09017002582550E-0001, 3.25568169355392E-0001, 3.42020153999329E-0001, 3.58367949724197E-0001, 3.74606579542160E-0001, 3.90731126070023E-0001, 4.06736642122269E-0001, 4.22618269920349E-0001, 4.38371151685715E-0001, 4.53990489244461E-0001, 4.69471573829651E-0001, 4.84809607267380E-0001, 5.00000000000000E-0001, 5.15038073062897E-0001, 5.29919266700745E-0001, 5.44639050960541E-0001, 5.59192895889282E-0001, 5.73576450347900E-0001, 5.87785243988037E-0001, 6.01815044879913E-0001, 6.15661501884460E-0001, 6.29320383071899E-0001, 6.42787635326385E-0001, 6.56059026718140E-0001, 6.69130623340607E-0001, 6.81998372077942E-0001, 6.94658398628235E-0001, 7.07106769084930E-0001, 7.19339787960052E-0001, 7.31353700160980E-0001, 7.43144810199738E-0001, 7.54709601402283E-0001, 7.66044437885284E-0001, 7.77145981788635E-0001, 7.88010776042938E-0001, 7.98635482788086E-0001, 8.09017002582550E-0001, 8.19152057170868E-0001, 8.29037547111511E-0001, 8.38670551776886E-0001, 8.48048090934753E-0001, 8.57167303562164E-0001, 8.66025388240814E-0001, 8.74619722366333E-0001, 8.82947564125061E-0001, 8.91006529331207E-0001, 8.98794054985046E-0001, 9.06307816505432E-0001, 9.13545429706573E-0001, 9.20504868030548E-0001, 9.27183866500854E-0001, 9.33580398559570E-0001, 9.39692616462708E-0001, 9.45518553256989E-0001, 9.51056540012360E-0001, 9.56304728984833E-0001, 9.61261689662933E-0001, 9.65925812721252E-0001, 9.70295727252960E-0001, 9.74370062351227E-0001, 9.78147625923157E-0001, 9.81627166271210E-0001, 9.84807729721069E-0001, 9.87688362598419E-0001, 9.90268051624298E-0001, 9.92546141147614E-0001, 9.94521915912628E-0001, 9.96194720268250E-0001, 9.97564077377319E-0001, 9.98629510402679E-0001, 9.99390840530396E-0001, 9.99847710132599E-0001, 1.00000000000000E+0000, 9.99847710132599E-0001, 9.99390840530396E-0001, 9.98629510402679E-0001, 9.97564077377319E-0001, 9.96194720268250E-0001, 9.94521915912628E-0001, 9.92546141147614E-0001, 9.90268051624298E-0001, 9.87688362598419E-0001, 9.84807729721069E-0001, 9.81627166271210E-0001, 9.78147625923157E-0001, 9.74370062351227E-0001, 9.70295727252960E-0001, 9.65925812721252E-0001, 9.61261689662933E-0001, 9.56304728984833E-0001, 9.51056540012360E-0001, 9.45518553256989E-0001, 9.39692616462708E-0001, 9.33580398559570E-0001, 9.27183866500854E-0001, 9.20504868030548E-0001, 9.13545429706573E-0001, 9.06307816505432E-0001, 8.98794054985046E-0001, 8.91006529331207E-0001, 8.82947564125061E-0001, 8.74619722366333E-0001, 8.66025388240814E-0001, 8.57167303562164E-0001, 8.48048090934753E-0001, 8.38670551776886E-0001, 8.29037547111511E-0001, 8.19152057170868E-0001, 8.09017002582550E-0001, 7.98635482788086E-0001, 7.88010776042938E-0001, 7.77145981788635E-0001, 7.66044437885284E-0001, 7.54709601402283E-0001, 7.43144810199738E-0001, 7.31353700160980E-0001, 7.19339787960052E-0001, 7.07106769084930E-0001, 6.94658398628235E-0001, 6.81998372077942E-0001, 6.69130623340607E-0001, 6.56059026718140E-0001, 6.42787635326385E-0001, 6.29320383071899E-0001, 6.15661501884460E-0001, 6.01815044879913E-0001, 5.87785243988037E-0001, 5.73576450347900E-0001, 5.59192895889282E-0001, 5.44639050960541E-0001, 5.29919266700745E-0001, 5.15038073062897E-0001, 5.00000000000000E-0001, 4.84809607267380E-0001, 4.69471573829651E-0001, 4.53990489244461E-0001, 4.38371151685715E-0001, 4.22618269920349E-0001, 4.06736642122269E-0001, 3.90731126070023E-0001, 3.74606579542160E-0001, 3.58367949724197E-0001, 3.42020153999329E-0001, 3.25568169355392E-0001, 3.09017002582550E-0001, 2.92371690273285E-0001, 2.75637358427048E-0001, 2.58819043636322E-0001, 2.41921901702881E-0001, 2.24951058626175E-0001, 2.07911685109138E-0001, 1.90808996558189E-0001, 1.73648178577423E-0001, 1.56434461474419E-0001, 1.39173105359077E-0001, 1.21869340538979E-0001, 1.04528464376926E-0001, 8.71557444334030E-0002, 6.97564706206322E-0002, 5.23359552025795E-0002, 3.48994955420494E-0002, 1.74524057656527E-0002, 1.48870954626290E-0012,-1.74524057656527E-0002,-3.48994955420494E-0002,-5.23359552025795E-0002, -6.97564706206322E-0002,-8.71557444334030E-0002,-1.04528464376926E-0001,-1.21869340538979E-0001, -1.39173105359077E-0001,-1.56434461474419E-0001,-1.73648178577423E-0001,-1.90808996558189E-0001, -2.07911685109138E-0001,-2.24951058626175E-0001,-2.41921901702881E-0001,-2.58819043636322E-0001, -2.75637358427048E-0001,-2.92371690273285E-0001,-3.09017002582550E-0001,-3.25568169355392E-0001, -3.42020153999329E-0001,-3.58367949724197E-0001,-3.74606579542160E-0001,-3.90731126070023E-0001, -4.06736642122269E-0001,-4.22618269920349E-0001,-4.38371151685715E-0001,-4.53990489244461E-0001, -4.69471573829651E-0001,-4.84809607267380E-0001,-5.00000000000000E-0001,-5.15038073062897E-0001, -5.29919266700745E-0001,-5.44639050960541E-0001,-5.59192895889282E-0001,-5.73576450347900E-0001, -5.87785243988037E-0001,-6.01815044879913E-0001,-6.15661501884460E-0001,-6.29320383071899E-0001, -6.42787635326385E-0001,-6.56059026718140E-0001,-6.69130623340607E-0001,-6.81998372077942E-0001, -6.94658398628235E-0001,-7.07106769084930E-0001,-7.19339787960052E-0001,-7.31353700160980E-0001, -7.43144810199738E-0001,-7.54709601402283E-0001,-7.66044437885284E-0001,-7.77145981788635E-0001, -7.88010776042938E-0001,-7.98635482788086E-0001,-8.09017002582550E-0001,-8.19152057170868E-0001, -8.29037547111511E-0001,-8.38670551776886E-0001,-8.48048090934753E-0001,-8.57167303562164E-0001, -8.66025388240814E-0001,-8.74619722366333E-0001,-8.82947564125061E-0001,-8.91006529331207E-0001, -8.98794054985046E-0001,-9.06307816505432E-0001,-9.13545429706573E-0001,-9.20504868030548E-0001, -9.27183866500854E-0001,-9.33580398559570E-0001,-9.39692616462708E-0001,-9.45518553256989E-0001, -9.51056540012360E-0001,-9.56304728984833E-0001,-9.61261689662933E-0001,-9.65925812721252E-0001, -9.70295727252960E-0001,-9.74370062351227E-0001,-9.78147625923157E-0001,-9.81627166271210E-0001, -9.84807729721069E-0001,-9.87688362598419E-0001,-9.90268051624298E-0001,-9.92546141147614E-0001, -9.94521915912628E-0001,-9.96194720268250E-0001,-9.97564077377319E-0001,-9.98629510402679E-0001, -9.99390840530396E-0001,-9.99847710132599E-0001,-1.00000000000000E+0000,-9.99847710132599E-0001, -9.99390840530396E-0001,-9.98629510402679E-0001,-9.97564077377319E-0001,-9.96194720268250E-0001, -9.94521915912628E-0001,-9.92546141147614E-0001,-9.90268051624298E-0001,-9.87688362598419E-0001, -9.84807729721069E-0001,-9.81627166271210E-0001,-9.78147625923157E-0001,-9.74370062351227E-0001, -9.70295727252960E-0001,-9.65925812721252E-0001,-9.61261689662933E-0001,-9.56304728984833E-0001, -9.51056540012360E-0001,-9.45518553256989E-0001,-9.39692616462708E-0001,-9.33580398559570E-0001, -9.27183866500854E-0001,-9.20504868030548E-0001,-9.13545429706573E-0001,-9.06307816505432E-0001, -8.98794054985046E-0001,-8.91006529331207E-0001,-8.82947564125061E-0001,-8.74619722366333E-0001, -8.66025388240814E-0001,-8.57167303562164E-0001,-8.48048090934753E-0001,-8.38670551776886E-0001, -8.29037547111511E-0001,-8.19152057170868E-0001,-8.09017002582550E-0001,-7.98635482788086E-0001, -7.88010776042938E-0001,-7.77145981788635E-0001,-7.66044437885284E-0001,-7.54709601402283E-0001, -7.43144810199738E-0001,-7.31353700160980E-0001,-7.19339787960052E-0001,-7.07106769084930E-0001, -6.94658398628235E-0001,-6.81998372077942E-0001,-6.69130623340607E-0001,-6.56059026718140E-0001, -6.42787635326385E-0001,-6.29320383071899E-0001,-6.15661501884460E-0001,-6.01815044879913E-0001, -5.87785243988037E-0001,-5.73576450347900E-0001,-5.59192895889282E-0001,-5.44639050960541E-0001, -5.29919266700745E-0001,-5.15038073062897E-0001,-5.00000000000000E-0001,-4.84809607267380E-0001, -4.69471573829651E-0001,-4.53990489244461E-0001,-4.38371151685715E-0001,-4.22618269920349E-0001, -4.06736642122269E-0001,-3.90731126070023E-0001,-3.74606579542160E-0001,-3.58367949724197E-0001, -3.42020153999329E-0001,-3.25568169355392E-0001,-3.09017002582550E-0001,-2.92371690273285E-0001, -2.75637358427048E-0001,-2.58819043636322E-0001,-2.41921901702881E-0001,-2.24951058626175E-0001, -2.07911685109138E-0001,-1.90808996558189E-0001,-1.73648178577423E-0001,-1.56434461474419E-0001, -1.39173105359077E-0001,-1.21869340538979E-0001,-1.04528464376926E-0001,-8.71557444334030E-0002, -6.97564706206322E-0002,-5.23359552025795E-0002,-3.48994955420494E-0002,-1.74524057656527E-0002, -2.97741909252580E-0012); CosVal : array[0..360] of single = ( 1.00000000000000E+0000, 9.99847710132599E-0001, 9.99390840530396E-0001, 9.98629510402679E-0001, 9.97564077377319E-0001, 9.96194720268250E-0001, 9.94521915912628E-0001, 9.92546141147614E-0001, 9.90268051624298E-0001, 9.87688362598419E-0001, 9.84807729721069E-0001, 9.81627166271210E-0001, 9.78147625923157E-0001, 9.74370062351227E-0001, 9.70295727252960E-0001, 9.65925812721252E-0001, 9.61261689662933E-0001, 9.56304728984833E-0001, 9.51056540012360E-0001, 9.45518553256989E-0001, 9.39692616462708E-0001, 9.33580398559570E-0001, 9.27183866500854E-0001, 9.20504868030548E-0001, 9.13545429706573E-0001, 9.06307816505432E-0001, 8.98794054985046E-0001, 8.91006529331207E-0001, 8.82947564125061E-0001, 8.74619722366333E-0001, 8.66025388240814E-0001, 8.57167303562164E-0001, 8.48048090934753E-0001, 8.38670551776886E-0001, 8.29037547111511E-0001, 8.19152057170868E-0001, 8.09017002582550E-0001, 7.98635482788086E-0001, 7.88010776042938E-0001, 7.77145981788635E-0001, 7.66044437885284E-0001, 7.54709601402283E-0001, 7.43144810199738E-0001, 7.31353700160980E-0001, 7.19339787960052E-0001, 7.07106769084930E-0001, 6.94658398628235E-0001, 6.81998372077942E-0001, 6.69130623340607E-0001, 6.56059026718140E-0001, 6.42787635326385E-0001, 6.29320383071899E-0001, 6.15661501884460E-0001, 6.01815044879913E-0001, 5.87785243988037E-0001, 5.73576450347900E-0001, 5.59192895889282E-0001, 5.44639050960541E-0001, 5.29919266700745E-0001, 5.15038073062897E-0001, 5.00000000000000E-0001, 4.84809607267380E-0001, 4.69471573829651E-0001, 4.53990489244461E-0001, 4.38371151685715E-0001, 4.22618269920349E-0001, 4.06736642122269E-0001, 3.90731126070023E-0001, 3.74606579542160E-0001, 3.58367949724197E-0001, 3.42020153999329E-0001, 3.25568169355392E-0001, 3.09017002582550E-0001, 2.92371690273285E-0001, 2.75637358427048E-0001, 2.58819043636322E-0001, 2.41921901702881E-0001, 2.24951058626175E-0001, 2.07911685109138E-0001, 1.90808996558189E-0001, 1.73648178577423E-0001, 1.56434461474419E-0001, 1.39173105359077E-0001, 1.21869340538979E-0001, 1.04528464376926E-0001, 8.71557444334030E-0002, 6.97564706206322E-0002, 5.23359552025795E-0002, 3.48994955420494E-0002, 1.74524057656527E-0002, 7.44354773131450E-0013, -1.74524057656527E-0002,-3.48994955420494E-0002,-5.23359552025795E-0002,-6.97564706206322E-0002, -8.71557444334030E-0002,-1.04528464376926E-0001,-1.21869340538979E-0001,-1.39173105359077E-0001, -1.56434461474419E-0001,-1.73648178577423E-0001,-1.90808996558189E-0001,-2.07911685109138E-0001, -2.24951058626175E-0001,-2.41921901702881E-0001,-2.58819043636322E-0001,-2.75637358427048E-0001, -2.92371690273285E-0001,-3.09017002582550E-0001,-3.25568169355392E-0001,-3.42020153999329E-0001, -3.58367949724197E-0001,-3.74606579542160E-0001,-3.90731126070023E-0001,-4.06736642122269E-0001, -4.22618269920349E-0001,-4.38371151685715E-0001,-4.53990489244461E-0001,-4.69471573829651E-0001, -4.84809607267380E-0001,-5.00000000000000E-0001,-5.15038073062897E-0001,-5.29919266700745E-0001, -5.44639050960541E-0001,-5.59192895889282E-0001,-5.73576450347900E-0001,-5.87785243988037E-0001, -6.01815044879913E-0001,-6.15661501884460E-0001,-6.29320383071899E-0001,-6.42787635326385E-0001, -6.56059026718140E-0001,-6.69130623340607E-0001,-6.81998372077942E-0001,-6.94658398628235E-0001, -7.07106769084930E-0001,-7.19339787960052E-0001,-7.31353700160980E-0001,-7.43144810199738E-0001, -7.54709601402283E-0001,-7.66044437885284E-0001,-7.77145981788635E-0001,-7.88010776042938E-0001, -7.98635482788086E-0001,-8.09017002582550E-0001,-8.19152057170868E-0001,-8.29037547111511E-0001, -8.38670551776886E-0001,-8.48048090934753E-0001,-8.57167303562164E-0001,-8.66025388240814E-0001, -8.74619722366333E-0001,-8.82947564125061E-0001,-8.91006529331207E-0001,-8.98794054985046E-0001, -9.06307816505432E-0001,-9.13545429706573E-0001,-9.20504868030548E-0001,-9.27183866500854E-0001, -9.33580398559570E-0001,-9.39692616462708E-0001,-9.45518553256989E-0001,-9.51056540012360E-0001, -9.56304728984833E-0001,-9.61261689662933E-0001,-9.65925812721252E-0001,-9.70295727252960E-0001, -9.74370062351227E-0001,-9.78147625923157E-0001,-9.81627166271210E-0001,-9.84807729721069E-0001, -9.87688362598419E-0001,-9.90268051624298E-0001,-9.92546141147614E-0001,-9.94521915912628E-0001, -9.96194720268250E-0001,-9.97564077377319E-0001,-9.98629510402679E-0001,-9.99390840530396E-0001, -9.99847710132599E-0001,-1.00000000000000E+0000,-9.99847710132599E-0001,-9.99390840530396E-0001, -9.98629510402679E-0001,-9.97564077377319E-0001,-9.96194720268250E-0001,-9.94521915912628E-0001, -9.92546141147614E-0001,-9.90268051624298E-0001,-9.87688362598419E-0001,-9.84807729721069E-0001, -9.81627166271210E-0001,-9.78147625923157E-0001,-9.74370062351227E-0001,-9.70295727252960E-0001, -9.65925812721252E-0001,-9.61261689662933E-0001,-9.56304728984833E-0001,-9.51056540012360E-0001, -9.45518553256989E-0001,-9.39692616462708E-0001,-9.33580398559570E-0001,-9.27183866500854E-0001, -9.20504868030548E-0001,-9.13545429706573E-0001,-9.06307816505432E-0001,-8.98794054985046E-0001, -8.91006529331207E-0001,-8.82947564125061E-0001,-8.74619722366333E-0001,-8.66025388240814E-0001, -8.57167303562164E-0001,-8.48048090934753E-0001,-8.38670551776886E-0001,-8.29037547111511E-0001, -8.19152057170868E-0001,-8.09017002582550E-0001,-7.98635482788086E-0001,-7.88010776042938E-0001, -7.77145981788635E-0001,-7.66044437885284E-0001,-7.54709601402283E-0001,-7.43144810199738E-0001, -7.31353700160980E-0001,-7.19339787960052E-0001,-7.07106769084930E-0001,-6.94658398628235E-0001, -6.81998372077942E-0001,-6.69130623340607E-0001,-6.56059026718140E-0001,-6.42787635326385E-0001, -6.29320383071899E-0001,-6.15661501884460E-0001,-6.01815044879913E-0001,-5.87785243988037E-0001, -5.73576450347900E-0001,-5.59192895889282E-0001,-5.44639050960541E-0001,-5.29919266700745E-0001, -5.15038073062897E-0001,-5.00000000000000E-0001,-4.84809607267380E-0001,-4.69471573829651E-0001, -4.53990489244461E-0001,-4.38371151685715E-0001,-4.22618269920349E-0001,-4.06736642122269E-0001, -3.90731126070023E-0001,-3.74606579542160E-0001,-3.58367949724197E-0001,-3.42020153999329E-0001, -3.25568169355392E-0001,-3.09017002582550E-0001,-2.92371690273285E-0001,-2.75637358427048E-0001, -2.58819043636322E-0001,-2.41921901702881E-0001,-2.24951058626175E-0001,-2.07911685109138E-0001, -1.90808996558189E-0001,-1.73648178577423E-0001,-1.56434461474419E-0001,-1.39173105359077E-0001, -1.21869340538979E-0001,-1.04528464376926E-0001,-8.71557444334030E-0002,-6.97564706206322E-0002, -5.23359552025795E-0002,-3.48994955420494E-0002,-1.74524057656527E-0002,-4.14074915848495E-0013, 1.74524057656527E-0002, 3.48994955420494E-0002, 5.23359552025795E-0002, 6.97564706206322E-0002, 8.71557444334030E-0002, 1.04528464376926E-0001, 1.21869340538979E-0001, 1.39173105359077E-0001, 1.56434461474419E-0001, 1.73648178577423E-0001, 1.90808996558189E-0001, 2.07911685109138E-0001, 2.24951058626175E-0001, 2.41921901702881E-0001, 2.58819043636322E-0001, 2.75637358427048E-0001, 2.92371690273285E-0001, 3.09017002582550E-0001, 3.25568169355392E-0001, 3.42020153999329E-0001, 3.58367949724197E-0001, 3.74606579542160E-0001, 3.90731126070023E-0001, 4.06736642122269E-0001, 4.22618269920349E-0001, 4.38371151685715E-0001, 4.53990489244461E-0001, 4.69471573829651E-0001, 4.84809607267380E-0001, 5.00000000000000E-0001, 5.15038073062897E-0001, 5.29919266700745E-0001, 5.44639050960541E-0001, 5.59192895889282E-0001, 5.73576450347900E-0001, 5.87785243988037E-0001, 6.01815044879913E-0001, 6.15661501884460E-0001, 6.29320383071899E-0001, 6.42787635326385E-0001, 6.56059026718140E-0001, 6.69130623340607E-0001, 6.81998372077942E-0001, 6.94658398628235E-0001, 7.07106769084930E-0001, 7.19339787960052E-0001, 7.31353700160980E-0001, 7.43144810199738E-0001, 7.54709601402283E-0001, 7.66044437885284E-0001, 7.77145981788635E-0001, 7.88010776042938E-0001, 7.98635482788086E-0001, 8.09017002582550E-0001, 8.19152057170868E-0001, 8.29037547111511E-0001, 8.38670551776886E-0001, 8.48048090934753E-0001, 8.57167303562164E-0001, 8.66025388240814E-0001, 8.74619722366333E-0001, 8.82947564125061E-0001, 8.91006529331207E-0001, 8.98794054985046E-0001, 9.06307816505432E-0001, 9.13545429706573E-0001, 9.20504868030548E-0001, 9.27183866500854E-0001, 9.33580398559570E-0001, 9.39692616462708E-0001, 9.45518553256989E-0001, 9.51056540012360E-0001, 9.56304728984833E-0001, 9.61261689662933E-0001, 9.65925812721252E-0001, 9.70295727252960E-0001, 9.74370062351227E-0001, 9.78147625923157E-0001, 9.81627166271210E-0001, 9.84807729721069E-0001, 9.87688362598419E-0001, 9.90268051624298E-0001, 9.92546141147614E-0001, 9.94521915912628E-0001, 9.96194720268250E-0001, 9.97564077377319E-0001, 9.98629510402679E-0001, 9.99390840530396E-0001, 9.99847710132599E-0001, 1.00000000000000E+0000); {============================================================================} { TYPE DEFINITIONS } {============================================================================} type t_matrix = array[1..9] of single; { A 3x3 matrix used for rotations and transformations on points. The 9 elements are formatted thusly: .- -. | 1 2 3 | | | | 4 5 6 | | | | 7 8 9 | `- -' } t_pointptr = ^t_point; t_point = record x, y, z : single; { These are the point's original 3D coordinates. These will not change throughout the course of the program. } xr, yr, zr : single; { These are the rotated copies of the original 3D coordinates. These are the points that will actually be plotted on the screen. } next : t_pointptr; { Pointer to the next 3D point. } end; t_meshptr = ^t_mesh; t_mesh = record p_head, p_tail : t_pointptr; { The head and tail to the list of points in the mesh. } next : t_meshptr; { The pointer to the next list of points. } end; t_triptr = ^t_tri; t_tri = record p1, p2, p3 : t_pointptr; { The three corners of the triangle are defined by the 3D points p1, p2, and p3. } zavg : single; next : t_triptr; { A pointer to the next triangle in the list. } end; {============================================================================} { GLOBAL VARIABLES } {============================================================================} var meshes : t_meshptr; { Pointer to the list of pointers to that point to the lists of 3D points. } t_head, t_tail : t_triptr; { Pointers to the first/last records in the list of triangles. } triarray : pointer; tria_seg, tria_ofs, t_count : word; { The number of triangles in the list. } CPU_Time : longint absolute $0:$046C; { Memory address of the computer's system clock. This variable will be a number, and will change when the clock changes. 18.2 of these numbers represent a second. } screenbufseg, screenbufofs : word; { Screen buffer's memory segment/offset. } startmem, endmem, starttime, endtime, framecount : longint; { Amount of memory at execution, amount of memory after everything's been loaded, the timer's start time, end time, and how many frames the program rendered between starttime/endtime. } width, s_depth, distance, xshift, yshift : single; { The variable size of all of the 3D Space that the object will be able to exist in. } palred, palgreen, palblue : boolean; { Setting these three values will determine what colour the object will be. You can mix colours by setting two of them to true. For example, palred and palblue set to true, and palgreen set to false would create a purple palette. } {============================================================================} { Procedure: InitializeGlobals } { Application: Sets global pointers/counters to nil. } {============================================================================} procedure InitializeGlobals; begin meshes := NIL; t_head := NIL; t_tail := NIL; t_count := 0; framecount := 0; palred := true; palgreen := true; palblue := false; end; {============================================================================} { Procedure: DisplayProgramHeader } { Application: Displays the program info/copyright message to the screen. } {============================================================================} procedure DisplayProgramHeader; begin writeln; writeln('3D Spin-o-Matic v'+version+' ù Last compiled on '+compdate); writeln('Copyrighted 1998 (MCMXCVIII) by Chris Gahan'); writeln; end; {============================================================================} { Procedure: ShowHelpScreen } { Application: Displays the help screen if the user entered incorrect } { command-line parameters. } {============================================================================} procedure ShowHelpScreen; begin writeln; writeln('Program Usage:'); writeln; writeln(' 3dspin '); writeln; writeln('Details:'); writeln; writeln(' is the name of a file that contains a list of'); writeln(' vertices connected by triangles which defines'); writeln(' a 3D Object. These can be created using 3DS2MSH.EXE'); writeln(' (see documentation for further information).'); end; {============================================================================} { Procedure: ExitWithError } { Application: Terminates the program with an errormessage/errorcode. } {============================================================================} procedure ExitWithError(errnum : byte; errmsg : string); begin TextMode(CO80); writeln('Abnormal program termination. Please report bug to author.'); writeln; writeln('+ Error #', errnum, ': ' + errmsg); writeln; halt; end; {============================================================================} { Function: CheckMem } { Application: Checks to see if there's enough memory left to do stuff. } {============================================================================} function CheckMem : boolean; begin checkmem := memavail > minmem; end; {============================================================================} { Procedure: SetCol } { Application: Sets colour 'c' in the palette to the defined combination of } { red, green and blue. } {============================================================================} procedure SetCol(c, R, G, B : integer); begin asm mov dx, $03C8 mov ax, c out dx, al mov dx, $03C9 mov ax, R out dx, al mov ax, G out dx, al mov ax, B out dx, al end; end; {============================================================================} { Procedure: RenderPalette } { Application: Creates a gradiated palette based on the booleans palred, } { palgreen and palblue. } {============================================================================} procedure RenderPalette; var R, G, B, i : integer; begin { This loop sets the first 63 colours to a gradient. } for i := 1 to 63 do begin if palred then R := i else R := 0; if palgreen then G := i else G := 0; if palblue then B := i else B := 0; SetCol(i, R, G, B); end; { Set the rest of the colours to the brightest possible value. } if palred then R := 63 else R := 0; if palgreen then G := 63 else G := 0; if palblue then B := 63 else B := 0; for i := 64 to 255 do begin SetCol(i, R, G, B); end; end; {============================================================================} { Procedure: InitializeGraphics } { Application: Creates a video buffer in dynamic memory and enters 320x200 } { 256 colour graphics mode. } {============================================================================} procedure InitializeGraphics; var Temp : pointer; begin asm { These two assembler commands put the video card into graphics mode 13h (320x200 with 256 colours). } mov ax, 13h int 10h end; if memavail > 64000 then begin GetMem(Temp, 64000); { Allocate the memory for the screen buffer. } screenbufseg := seg(Temp^); screenbufofs := ofs(Temp^); RenderPalette; end else ExitWithError(204, 'Out of memory in InitializeGraphics.'); end; {============================================================================} { Procedure: DeInitializeGraphics } { Application: Deallocate the memory used by the video buffer and put the } { video card back into text mode. } {============================================================================} procedure DeInitializeGraphics; var Temp : pointer; begin Temp := Ptr(screenbufseg, screenbufofs); FreeMem(Temp, 64000); TextMode(CO80); { Enter 80x25, 16 colour text mode. } end; {============================================================================} { Procedure: PageFlip } { Application: Copies the screen buffer to the screen. } {============================================================================} procedure PageFlip; var i : word; begin { The following implementation copies the buffer to the video screen while simultaneously clearing the screen buffer, and doing it using 32-bits at a time. Doing it this way gave a 2 frame-per-second speed increase! } i := 64000; while (i > 0) do begin MemL[screen:i] := MemL[screenbufseg:i+screenbufofs]; MemL[screenbufseg:i+screenbufofs] := $00000000; {dec(i, 4);} i := i - 4; end; end; {============================================================================} { Procedure: PageCopy } { Application: Copies the screen buffer to the screen (does not clear it). } {============================================================================} procedure PageCopy; var i : word; b : byte; begin { The following implementation copies the buffer to the video screen while simultaneously clearing the screen buffer, and doing it using 32-bits at a time. Doing it this way gave a 2 frame-per-second speed increase! } i := 64000; while (i > 0) do begin MemL[screen:i] := MemL[screenbufseg:i+screenbufofs]; {dec(i, 4);} i := i - 4; end; end; {============================================================================} { Procedure: PutPixel } { Application: Draws one pixel to the screen at x, y in the colour 'c'. } {============================================================================} procedure PutPixel(x, y : integer; c : byte); begin Mem[screenbufseg:(y*320)+x+screenbufofs] := c; end; {============================================================================} { Procedure: Blur } { Application: Blurs all of the pixels on the screen. } {============================================================================} procedure Blur; { var where : word; begin where := 321; while (where < 63679) do begin Mem[screen:where] := ((Mem[screen:where-321] + Mem[screen:where-320] + Mem[screen:where-319] + Mem[screen:where-1] + Mem[screen:where+1] + Mem[screen:where+319] + Mem[screen:where+320] + Mem[screen:where+321]) shr 3); where := where + 1; end; end; } (* assembler; asm mov ax,screenbufseg { screen address } mov es,ax { ES=screen } mov di,screenbufofs mov cx,320*200 xor bx,bx @lp1: xor ax,ax mov al,es:[di] mov bl,es:[di-1] add ax,bx mov bl,es:[di+1] add ax,bx mov bl,es:[di+320] add ax,bx shr ax,2 jz @lp2 dec al @lp2: mov es:[di],al { ?! 'stosb' would suffice for these two } inc di { lines but this is faster I guess } dec cx jnz @lp1 end; temp mov al, BYTE PTR ds:[si-321] mov bl, BYTE PTR ds:[si-320] add ax, bx mov bl, BYTE PTR ds:[si-319] add ax, bx mov bl, BYTE PTR ds:[si-1] add ax, bx mov bl, BYTE PTR ds:[si+1] add ax, bx mov bl, BYTE PTR ds:[si+319] add ax, bx mov bl, BYTE PTR ds:[si+320] add ax, bx mov bl, BYTE PTR ds:[si+321] add ax, bx *) { Blur 2 } assembler; asm push ds mov ds, [screenbufseg] mov di, [screenbufofs] { mov si, 1 xor bx, bx xor ax, ax @top: mov al, BYTE PTR ds:[si-1] mov bl, BYTE PTR ds:[si+1] add ax, bx mov bl, BYTE PTR ds:[si+319] add ax, bx mov bl, BYTE PTR ds:[si+320] add ax, bx mov bl, BYTE PTR ds:[si+321] add ax, bx inc si cmp si, 321 jne @top } mov si, 321 mov cx, 63358 xor bx, bx xor ax, ax @middle: mov al, ds:[si-321] mov bl, ds:[si-320] add ax, bx mov bl, ds:[si-319] add ax, bx mov bl, ds:[si-1] add ax, bx mov bl, ds:[si+1] add ax, bx mov bl, ds:[si+319] add ax, bx mov bl, ds:[si+320] add ax, bx mov bl, ds:[si+321] add ax, bx shr ax, 3 mov ds:[si], al inc si dec cx jnz @middle { mov si, 63481 mov cx, 317 @bottom: mov al, BYTE PTR ds:[si-321] mov bl, BYTE PTR ds:[si-320] add ax, bx mov bl, BYTE PTR ds:[si-319] add ax, bx mov bl, BYTE PTR ds:[si-1] add ax, bx mov bl, BYTE PTR ds:[si+1] add ax, bx inc si dec cx jnz @bottom } pop ds end; {============================================================================} { Procedure: TriAngle } { Application: Draws a 2D triangle to the scree of colour 'Color'. The } { three vertices are [x1,y1], [x2,y2] and [x3,y3]. } {============================================================================} Procedure TriAngle(X1,Y1,X2,Y2,X3,Y3:Integer; Color:Byte); assembler; Var RV1,RV2,IF1,IF2,DeX1,DeX2,DeY1,DeY2 : Integer; Asm CLI {Sort by Y-value} Mov CX,2 @@SortLoop: Mov AX,[Y2]; Cmp AX,[Y3]; JBE @@Skip1 Xor AX,[Y3]; Xor [Y3],AX; Xor AX,[Y3]; Mov [Y2],AX Mov AX,[X2]; Xor AX,[X3]; Xor [X3],AX; Xor AX,[X3]; Mov [X2],AX @@Skip1: Mov AX,[Y1]; Cmp AX,[Y2]; JBE @@Skip2 Xor AX,[Y2]; Xor [Y2],AX; Xor AX,[Y2]; Mov [Y1],AX Mov AX,[X1]; Xor AX,[X2]; Xor [X2],AX; Xor AX,[X2]; Mov [X1],AX @@Skip2: Mov AX,[Y1]; Cmp AX,[Y3]; JBE @@Skip3 Xor AX,[Y3]; Xor [Y3],AX; Xor AX,[Y3]; Mov [Y1],AX Mov AX,[X1]; Xor AX,[X3]; Xor [X3],AX; Xor AX,[X3]; Mov [X1],AX @@Skip3: Loop @@SortLoop {Calculate start-offsets} Mov DX,[Y1]; Shl DX,6; Mov BX,DX; Shl DX,2; Add DX,BX Add DX,[X1]; Add DX,1; Mov SI,DX {Claculate DY, and fill DeY en RefVar with it} {Just sorted by Y-value, so no checking for <0 is needed} Mov AX,[Y3]; Sub AX,[Y1]; Inc AX; Mov [DeY1],AX Mov [RV1],AX; Mov AX,[Y2]; Sub AX,[Y1]; Inc AX Mov [DeY2],AX; Mov [RV2],AX {Same for DX. Possible to get a <0 value, so check for that} Mov [IF1],1; Mov AX,[X3]; Sub AX,[X1]; JNC @@SkipDXNeg1 Neg AX; Neg [IF1] @@SkipDXNeg1: Inc AX; Mov [DeX1],AX; Mov [IF2],1; Mov AX,[X2] Sub AX,[X1]; JNC @@SkipDXNeg2; Neg AX; Neg [IF2] @@SkipDXNeg2: Inc AX; Mov [DeX2],AX {Video segment in ES} Mov AX,screenbufseg; Mov ES,AX Mov DI,screenbufofs Mov AL,[Color]; Mov AH,AL; Mov CX,[DeY2] @@DrawLoop1: Push CX {Draw a horizontal line} Mov DI,DX Mov CX,SI Cmp CX,DI JA @@DontSwap1 Xchg CX,DI @@DontSwap1: Sub CX,DI Inc CX Test CX,1 JZ @@Even1 StosB @@Even1: Shr CX,1 Rep StosW {Adapt: RV1, Ofs1} Mov BX,[RV1] Sub BX,[DeX1] Cmp BX,0 JG @@DoNothing1 @@DoSomething1: Add BX,[DeY1] Add DX,[IF1] Cmp BX,0 JLE @@DoSomething1 @@DoNothing1: Add DX,320 Mov [RV1],BX {Adapt: RV2, Ofs2} Mov BX,[RV2] Sub BX,[DeX2] Cmp BX,0 JG @@DoNothing2 @@DoSomething2: Add BX,[DeY2] Add SI,[IF2] Cmp BX,0 JLE @@DoSomething2 @@DoNothing2: Add SI,320 Mov [RV2],BX Pop CX Loop @@DrawLoop1 {Adapt: DeY2, DeX2, RV2, IF2} Push DX Mov DX,[Y3] Sub DX,[Y2] Inc DX Mov [DeY2],DX Mov [RV2],DX Mov [IF2],1 Mov DX,[X3] Sub DX,[X2] JNC @@DX2Pos Neg DX Neg [IF2] @@DX2Pos: Inc DX Mov [DeX2],DX Pop DX {Draw second half of poly} Mov CX,[DeY2] @@DrawLoop2: Push CX {Draw a horizontal line} Mov DI,DX Mov CX,SI Cmp CX,DI JA @@DontSwap2 Xchg CX,DI @@DontSwap2: Sub CX,DI Inc CX Test CX,1 JZ @@Even2 StosB @@Even2: Shr CX,1 Rep StosW {Adapt: RV1, Ofs1} Mov BX,[RV1] Sub BX,[DeX1] Cmp BX,0 JG @@DoNothing3 @@DoSomething3: Add BX,[DeY1] Add DX,[IF1] Cmp BX,0 JLE @@DoSomething3 @@DoNothing3: Add DX,320 Mov [RV1],BX {Adapt: RV2, Ofs2} Mov BX,[RV2] Sub BX,[DeX2] Cmp BX,0 JG @@DoNothing4 @@DoSomething4: Add BX,[DeY2] Add SI,[IF2] Cmp BX,0 JLE @@DoSomething4 @@DoNothing4: Add SI,320 Mov [RV2],BX Pop CX Loop @@DrawLoop2 @@Exit: STI End;{NewTri3} {============================================================================} { Function: Exist } { Application: Returns true if "FileName" exists, otherwise false. } {============================================================================} function Exist(FileName: string) : Boolean; { Checks if a DOS file exists } var DirInfo: SearchRec; begin FindFirst(FileName, AnyFile, DirInfo); Exist := DosError = 0; end; {============================================================================} { Procedure: AddMesh } { Application: Adds a mesh-header to the meshlist. A mesh-header is a } { record that points to a list of 3d coordinates. } {============================================================================} procedure AddMesh(var newmesh : t_meshptr); begin if checkmem then begin new(newmesh); newmesh^.p_head := NIL; newmesh^.p_tail := NIL; newmesh^.next := meshes; { Push mesh to top of list } meshes := newmesh; end else ExitWithError(200, 'Out of memory in AddMesh.'); end; {============================================================================} { Procedure: CreatePoint } { Application: Adds a point to the points list (very robust). } {============================================================================} procedure CreatePoint(var mesh : t_meshptr; x, y, z : single); var pt : t_pointptr; count : longint; newmesh : boolean; begin { CreatePoint } newmesh := false; if not checkmem then ExitWithError(201, 'Out of memory in CreatePoint.'); new(pt); pt^.x := x; pt^.y := y; pt^.z := z; pt^.xr := x; pt^.yr := y; pt^.zr := z; pt^.next := NIL; { Check if tail is nil. } if (mesh^.p_tail = NIL) then begin { If the tail is nil and the top is nil, this is a new list. } if (mesh^.p_head = NIL) then begin mesh^.p_head := pt; mesh^.p_tail := pt; newmesh := true; end { Otherwise, the tail was moved one step too far, so we have to fix it by starting at the head and finding the end, and setting the tail to the last record in the list. } else begin mesh^.p_tail := mesh^.p_head; while (mesh^.p_tail^.next <> NIL) do mesh^.p_tail := mesh^.p_tail^.next; end; end; { if (mesh^.p_tail = NIL) } { If the tail is not at the end of the list, then adding this record in will sever the current list. This loop tries to fix this problem. } if (mesh^.p_tail^.next <> NIL) then begin count := 0; while (mesh^.p_tail^.next <> NIL) and (count < 66000) do begin mesh^.p_tail := mesh^.p_tail^.next; inc(count); end; { If we've looped more than 66,000 times, odds are, the list has a short-circuited link. At this point, the list is unsalvageable and it's time to terminate with an error. } if (count < 66000) then { Error #100 } ExitWithError(100, 'Points List has short-circuited.'); end; { if (mesh^.p_tail^.next <> NIL) } { Link the new point into the list. } if (mesh^.p_tail^.next = NIL) then begin if (not newmesh) then begin mesh^.p_tail^.next := pt; mesh^.p_tail := pt; end; end else { Error #101 } ExitWithError(101, 'Unsalvageable Points List.'); end; { CreatePoint } {============================================================================} { Procedure: LoadPoints } { Application: Reads in the first set of points in the file. } {============================================================================} procedure LoadPoints(var f : text; var mesh : t_meshptr; var num_points : word); var i : word; x, y, z : single; begin { LoadPoints } { Determine how many points will be loaded. } readln(f, num_points); { Read in all the points for this mesh. } for i := 1 to num_points do begin readln(f, x); readln(f, y); readln(f, z); { Add this point to the linked list of points. } CreatePoint(mesh, x, y, z); end; end; { LoadPoints } {============================================================================} { Procedure: PointPtr } { Application: Returns the pointer to the 'x'th point in the linked list of } { triangles. This list is defined by the pointer 'top' which } { is the first record in the list. This first record is } { at x = 0. } {============================================================================} function PointPtr(var top : t_pointptr; x : word) : t_pointptr; var ret : t_pointptr; i : word; begin ret := top; i := 1; while (i <= x) and (ret <> NIL) do begin ret := ret^.next; inc(i); end; if (ret = NIL) then { Error #102 } ExitWithError(102, 'Attempted to reference past end of list.') else PointPtr := ret; end; {============================================================================} { Procedure: CreateTriangle } { Application: Adds a triangle to the linked list of triangles. } {============================================================================} procedure CreateTriangle(a, b, c : t_pointptr); var newtri : t_triptr; count : longint; newlist : boolean; begin newlist := false; if not checkmem then ExitWithError(202, 'Out of memory in CreateTriangle.'); new(newtri); inc(t_count); newtri^.p1 := a; newtri^.p2 := b; newtri^.p3 := c; newtri^.next := NIL; { Check if tail is nil. } if (t_tail = NIL) then begin { If the tail is nil and the top is nil, this is a new list. } if (t_head = NIL) then begin t_head := newtri; t_tail := newtri; newlist := true; end { Otherwise, the tail was moved one step too far, and is now NIL, so we have to fix it. Setting it equal to the head will cause the next if statement below to fix it. } else t_tail := t_head; end; { if (t_tail = NIL) } { If the tail is not at the end of the list, then adding this record will sever the list at t_tail's current position. This loop tries to fix this problem by moving the pointer to the end. } if (t_tail^.next <> NIL) then begin count := 0; while (t_tail^.next <> NIL) and (count < 66000) do begin t_tail := t_tail^.next; inc(count); end; { If we've looped more than 66,000 times, odds are, the list has a short-circuited link. At this point, the list is unsalvageable and it's time to terminate with an error. } if (count < 66000) then { Error #103 } ExitWithError(103, 'Triangles List has short-circuited.'); end; { if (t_tail^.next <> NIL) } { Link the new point into the list. } if (t_tail^.next = NIL) then begin if (not newlist) then begin t_tail^.next := newtri; t_tail := newtri; end; end else { If all that we just did didn't work, the list has some serious linking problems. } { Error #104 } ExitWithError(104, 'Unsalvageable Triangles List.'); end; {============================================================================} { Procedure: LoadTriangles } { Application: Loads the triangle-definitions from the file and generates a } { triangles list. } {============================================================================} procedure LoadTriangles(var f : text; var mesh : t_meshptr; var num_points : word); var a, b, c : word; { The three vertices of the triangle, each vertex as a reference to a point's order in the points list. } pa, pb, pc : t_pointptr; { Pointers to the points that are the three vertices of the triangle. } newtri : t_triptr; i, num_triangles : word; begin readln(f, num_triangles); for i := 1 to num_triangles do begin { Read in the three vertices of the triangle. } readln(f, a); readln(f, b); readln(f, c); { Return the pointers to the triangle's three points. } pa := PointPtr(mesh^.p_head, a); pb := PointPtr(mesh^.p_head, b); pc := PointPtr(mesh^.p_head, c); { Add this triangle to the triangle list. } CreateTriangle(pa, pb, pc); end; end; {============================================================================} { Function: LoadMeshFile } { Application: Loads the mesh file and creates a points list, and a } { triangles list. } {============================================================================} function LoadMeshFile : boolean; var result : boolean; num_points, num_faces : word; f : text; p, mesh : t_meshptr; i : integer; begin if exist(paramstr(1)) then begin { if the file that the user may have entered exists... } assign(f, paramstr(1)); reset(f); writeln('þ Loading '+fexpand(paramstr(1))+'...'); i := 1; { Loop until all objects are read. } while not eof(f) do begin AddMesh(mesh); writeln(' À Object #', i, ': Loading vertices...'); LoadPoints(f, mesh, num_points); writeln(' À Object #', i, ': Loading triangles...'); LoadTriangles(f, mesh, num_points); inc(i); end; close(f); result := true; { File was found and loaded. } if (t_count <= 16000) then begin writeln; writeln('þ Total triangles loaded: ', t_count); writeln; end else begin writeln('þ Shape contains ', t_count,' triangles. The maximum is 16000.'); halt(1); end; end else begin { user did not enter a valid filename... } ShowHelpScreen; result := false; end; LoadMeshFile := result; { Return result of loading file (true means file loaded successfully, false means file not found or loaded incorrectly). } end; {============================================================================} { Function: ScaleObject } { Application: This determines the length of the farthest point in the } { object and sets the appropriate global variables. } {============================================================================} procedure ScaleObject; var mag, max : single; p : t_triptr; begin p := t_head; max := 0; while (p <> nil) do begin mag := sqrt(abs(sqr(p^.p1^.x) + sqr(p^.p1^.y) + sqr(p^.p1^.z))); if (mag > max) then max := mag; mag := sqrt(abs(sqr(p^.p2^.x) + sqr(p^.p2^.y) + sqr(p^.p2^.z))); if (mag > max) then max := mag; mag := sqrt(abs(sqr(p^.p3^.x) + sqr(p^.p3^.y) + sqr(p^.p3^.z))); if (mag > max) then max := mag; p := p^.next; end; s_depth := max * 1.8; distance := max * 1.9; xshift := 0; yshift := 0; end; {============================================================================} { Procedure: Multiply3x3Matrix } { Application: Multiplies the two matricies 'm1' and m2' and returns the } { result in 'result' (see the t_matrix definition for } { formatting information). } {============================================================================} procedure Multiply3x3Matrix(m1, m2 : t_matrix; var result : t_matrix); begin result[1] := m1[1]*m2[1] + m1[2]*m2[4] + m1[3]*m2[7]; result[2] := m1[1]*m2[2] + m1[2]*m2[5] + m1[3]*m2[8]; result[3] := m1[1]*m2[3] + m1[2]*m2[6] + m1[3]*m2[9]; result[4] := m1[4]*m2[1] + m1[5]*m2[4] + m1[6]*m2[7]; result[5] := m1[4]*m2[2] + m1[5]*m2[5] + m1[6]*m2[8]; result[6] := m1[4]*m2[3] + m1[5]*m2[6] + m1[6]*m2[9]; result[7] := m1[7]*m2[1] + m1[8]*m2[4] + m1[9]*m2[7]; result[8] := m1[7]*m2[2] + m1[8]*m2[5] + m1[9]*m2[8]; result[9] := m1[7]*m2[3] + m1[8]*m2[6] + m1[9]*m2[9]; end; {============================================================================} { Procedure: Set_TArray } { Application: Set the element in the virtual array to the pointer 'p'. } {============================================================================} procedure Set_TArray(element : integer; p : t_triptr); var o : word; begin o := (element-1) * 4; MemW[tria_seg:tria_ofs+o] := seg(p^); MemW[tria_seg:tria_ofs+o+2] := ofs(p^); end; {============================================================================} { Procedure: Get_TArray } { Application: Return the pointer at the element in the virtual array. } {============================================================================} function Get_TArray(element : integer) : t_triptr; var o : word; begin o := (element-1) * 4; Get_TArray := ptr(MemW[tria_seg:tria_ofs+o], MemW[tria_seg:tria_ofs+o+2]); end; {============================================================================} { Procedure: MakeTriangleArray } { Application: Creates a virtual array (a bin) in which the entire triangle } { list will be stored. This is to speed up the quicksorting. } {============================================================================} procedure MakeTriangleArray; var p : t_triptr; i : integer; begin GetMem(triarray, (t_count+1) * 4); tria_seg := seg(triarray^); tria_ofs := ofs(triarray^); p := t_head; for i := 1 to t_count do begin Set_TArray(i, p); p := p^.next; end; end; {============================================================================} { Procedure: NukeTriangleArray } { Application: Free up memory used by the virtual triangle array. } {============================================================================} procedure NukeTriangleArray; begin freemem(triarray, t_count * 4); end; {============================================================================} { Procedure: CalculateZAverages } { Application: Determine the average of the three Z coordinates for each } { triangle. } {============================================================================} procedure CalculateZAverages; var t : t_triptr; i : integer; begin t := t_head; for i := 1 to t_count do begin t := get_tarray(i); t^.zavg := (t^.p1^.zr + t^.p2^.zr + t^.p3^.zr) / 3; end; end; {============================================================================} { Procedure: Swap } { Application: Swap the two pointers at positions 'a' and 'b' in the virtual } { array. } {============================================================================} procedure Swap(a, b : integer); var tmp : t_triptr; begin tmp := Get_TArray(a); Set_TArray(a, Get_TArray(b)); Set_TArray(b, tmp); end; {============================================================================} { Procedure: QuickSort } { Application: This procedure recursively sorts the triangles in the virtual } { array bazed on their average Z coordinate, in descending } { order (farthest will be at the beginning, closest at the end).} {============================================================================} procedure QuickSort(top, bottom : word); var lower, upper, middle : word; pivot : single; begin lower := top; upper := bottom; middle:= (top + bottom) div 2; pivot := get_tarray(middle)^.zavg; repeat while (get_tarray(lower)^.zavg < pivot) do inc(lower); while (pivot < get_tarray(upper)^.zavg) do dec(upper); if (lower <= upper) then begin swap(lower, upper); inc(lower); dec(upper); end; until (lower > upper); if top < upper then QuickSort(top,upper); if (lower < bottom) then QuickSort(lower,bottom); end; { QuickSort } {============================================================================} { Procedure: Yaw } { Application: Calculate the matrix for a yaw rotation of 'd' degrees. } {============================================================================} procedure Yaw(var r : t_matrix; d : integer); begin r[1] := 1; r[2] := 0; r[3] := 0; r[4] := 0; r[5] := cosval[d]; r[6] := -sinval[d]; r[7] := 0; r[8] := sinval[d]; r[9] := cosval[d]; end; {============================================================================} { Procedure: Pitch } { Application: Calculate the matrix for a pitch rotation of 'd' degrees. } {============================================================================} procedure Pitch(var r : t_matrix; d : integer); begin r[1] := cosval[d]; r[2] := 0; r[3] := sinval[d]; r[4] := 0; r[5] := 1; r[6] := 0; r[7] := -sinval[d]; r[8] := 0; r[9] := cosval[d]; end; {============================================================================} { Procedure: Roll } { Application: Calculate the matrix for a roll rotation of 'd' degrees. } {============================================================================} procedure Roll(var r : t_matrix; d : integer); begin r[1] := cosval[d]; r[2] := -sinval[d]; r[3] := 0; r[4] := sinval[d]; r[5] := cosval[d]; r[6] := 0; r[7] := 0; r[8] := 0; r[9] := 1; end; {============================================================================} { Procedure: ApplyRotations } { Application: Create the needed matricies and multiply every point in the } { object by them. } {============================================================================} procedure ApplyRotations(ydeg, pdeg, rdeg : integer); var tmp, rot, y_m, p_m, r_m : t_matrix; { Yaw, Pitch and Roll matricies. } m : t_meshptr; p : t_pointptr; begin Yaw(y_m, ydeg); Pitch(p_m, pdeg); Roll(r_m, rdeg); Multiply3x3Matrix(y_m, p_m, tmp); Multiply3x3Matrix(tmp, r_m, rot); m := meshes; while (m <> nil) do begin p := m^.p_head; while (p <> nil) do begin { This multiplies a 3x3 rotation matrix (rot) by a 3x1 coordinate matrix. } p^.xr := (rot[1] * p^.x) + (rot[2] * p^.y) + (rot[3] * p^.z) + xshift; p^.yr := (rot[4] * p^.x) + (rot[5] * p^.y) + (rot[6] * p^.z) + yshift; p^.zr := (rot[7] * p^.x) + (rot[8] * p^.y) + (rot[9] * p^.z) - distance; p := p^.next; end; m := m^.next; end; end; {============================================================================} { Procedure: XClip } { Application: Returns true if the three x coordinates inside of the } { visible screen. } {============================================================================} function XClip(x1, x2, x3 : integer) : boolean; begin XClip := (x1 < XMAX) and (x1 >= 0) and (x2 < XMAX) and (x2 >= 0) and (x3 < XMAX) and (x3 >= 0); end; {============================================================================} { Procedure: YClip } { Application: Returns true if the three y coordinates inside of the } { visible screen. } {============================================================================} function YClip(y1, y2, y3 : integer) : boolean; begin YClip := (y1 < YMAX) and (y1 >= 0) and (y2 < YMAX) and (y2 >= 0) and (y3 < YMAX) and (y3 >= 0); end; {============================================================================} { Procedure: DrawVertices } { Application: Draws all the vertices in the object (projected from 3D } { space to 2D space) as points on the screen. } {============================================================================} procedure DrawVertices; var tmp : single; m : t_meshptr; p : t_pointptr; c, x, y : word; begin m := meshes; while (m <> nil) do begin p := m^.p_head; while (p <> nil) do begin { Convert the rotated point's 3D coordinates to perspective-correct 2D Coordinates. } x := round(p^.xr / p^.zr * XSCALE) + XMID; y := round(p^.yr / p^.zr * YSCALE) + YMID; tmp := 63.0 * (p^.zr / (s_depth*2.5)); c := 74 + round(tmp); if c > 74 then c := 0; if (x < XMAX) and (x >= 0) and (y < YMAX) and (y >= 0) then Putpixel(x, y, c); p := p^.next; end; m := m^.next; end; end; {============================================================================} { Procedure: DrawFatVertices } { Application: Draws all the vertices in the object (projected from 3D } { space to 2D space) as points on the screen. } {============================================================================} procedure DrawFatVertices; var tmp : single; m : t_meshptr; p : t_pointptr; c, x, y : word; begin m := meshes; while (m <> nil) do begin p := m^.p_head; while (p <> nil) do begin { Convert the rotated point's 3D coordinates to perspective-correct 2D Coordinates. } x := round(p^.xr / p^.zr * XSCALE) + XMID; y := round(p^.yr / p^.zr * YSCALE) + YMID; tmp := 63.0 * (p^.zr / (s_depth*2.5)); c := 74 + round(tmp); if c > 74 then c := 0; if (x < XMAX) and (x >= 0) and (y < YMAX) and (y >= 0) then begin Putpixel(x, y, c); Putpixel(x+1, y, c); Putpixel(x-1, y, c); Putpixel(x, y+1, c); Putpixel(x, y-1, c); end; p := p^.next; end; m := m^.next; end; end; {============================================================================} { Procedure: DrawObject } { Application: Draws all the triangles in the object (projected from 3D } { space to 2D space). } {============================================================================} procedure DrawObject; var tmp : single; i : integer; p : t_triptr; c, x1, y1, x2, y2, x3, y3 : word; { The screen X and Y coordinates. } begin for i := 1 to t_count do begin p := get_tarray(i); { Convert the first rotated vertex's 3D coordinates to perspective- correct 2D Coordinates. } x1 := round(p^.p1^.xr / p^.p1^.zr * XSCALE) + XMID; y1 := round(p^.p1^.yr / p^.p1^.zr * YSCALE) + YMID; { Convert the second rotated vertex's 3D coordinates to perspective- correct 2D Coordinates. } x2 := round(p^.p2^.xr / p^.p2^.zr * XSCALE) + XMID; y2 := round(p^.p2^.yr / p^.p2^.zr * YSCALE) + YMID; { Convert the third rotated vertex's 3D coordinates to perspective- correct 2D Coordinates. } x3 := round(p^.p3^.xr / p^.p3^.zr * XSCALE) + XMID; y3 := round(p^.p3^.yr / p^.p3^.zr * YSCALE) + YMID; tmp := 63.0 * (p^.zavg / (s_depth*2.0)); c := 64 + round(tmp); if c > 64 then c := 0; { The XClip and YClip functions are only implemented for robustness. If something goes TERRIBLY wrong and the triangles' coordinates start getting set outside of the visible window, these miscreant trinagles will not be drawn. } if xclip(x1, x2, x3) and yclip(y1, y2, y3) then Triangle(x1, y1, x2, y2, x3, y3, c); end; end; {============================================================================} { Procedure: SpinObject } { Application: This procedure does a few things. First, it calls all of the } { procedures needed to Rotate the object. Next, it determines } { whether it should be drawing triangles, or just vertices. } { It'll then sort the triangles (if it has to) and draw the } { object to the screen. It then executes a bunch of case } { statements that check for all the different keys the user } { could press, such as changing the rotation, moving the object,} { changing the colour of the object, toggling between triangles } { and vertices drawing modes, or, ultimately, quitting. It } { will finally update the frame counter and flip the screen } { buffer to the screen, and loop until the user wants to quit. } {============================================================================} procedure SpinObject; var yvel, pvel, rvel, veljump, yawdeg, pitchdeg, rolldeg, i : integer; { Yvel, Pvel and Rvel are the Yaw, Pitch and Roll velocities in degrees. The value of these three variables is added to yawdeg, pitchdeg, and rolldeg each time the object is rotated. } tmp : t_triptr; triangles, blurred, smooth, leave, done : boolean; { Triangles states whether triangles, or just vertices should be drawn. Done monitors if the user would like to quit. } c : char; begin yvel := 0; pvel := 0; rvel := 0; { Initial rotation velocities. } veljump := 2; { Amount that y/p/rvel should change each time the user increases/decreases their values. veljump is changed in the program using the +/- keys. } yawdeg := 0; pitchdeg := 0; rolldeg := 0; done := false; triangles := true; blurred := false; smooth := false; leave := false; while not done do begin ApplyRotations(yawdeg, pitchdeg, rolldeg); { Increment the rotations for the next animated frame. } yawdeg := yawdeg + yvel; pitchdeg := pitchdeg + pvel; rolldeg := rolldeg + rvel; if (yawdeg > 360) then yawdeg := yawdeg - 360; if (pitchdeg > 360) then pitchdeg := pitchdeg - 360; if (rolldeg > 360) then rolldeg := rolldeg - 360; if triangles then begin CalculateZAverages; QuickSort(1, t_count); { Sort the triangles from back to front. } DrawObject; end else if blurred or smooth then DrawFatVertices else DrawVertices; if blurred then begin Blur; PageCopy; end else if smooth then begin Blur; PageFlip; end else if leave then PageCopy else PageFlip; inc(framecount); while keypressed do begin c := upcase(readkey); case c of #27 : done := true; '+' : if veljump < 359 then inc(veljump); '-' : if veljump > 1 then dec(veljump); 'C' : begin yawdeg := 0; pitchdeg := 0; rolldeg := 0; yvel := 0; pvel := 0; rvel := 0; { Initial rotation values. } xshift := 0; yshift := 0; end; ' ' : begin yvel := 0; pvel := 0; rvel := 0; { Initial rotation values. } veljump := 2; end; '4' : xshift := xshift - veljump; { Left Arrow } '6' : xshift := xshift + veljump; { Right Arrow } '2' : yshift := yshift - veljump; { Left Arrow } '8' : yshift := yshift + veljump; { Right Arrow } '5' : distance := distance + veljump; { Up Arrow } '0' : distance := distance - veljump; { Down Arrow } #0 : begin c := readkey; case c of #82 : inc(yvel, veljump); { Insert } #83 : dec(yvel, veljump); { Delete } #71 : inc(pvel, veljump); { Home } #79 : dec(pvel, veljump); { End } #73 : inc(rvel, veljump); { Page Up } #81 : dec(rvel, veljump); { Page Down } #72 : distance := distance + veljump; { Up Arrow } #80 : distance := distance - veljump; { Down Arrow } end; end; 'R' : begin { Toggle red component of palette. } palred := not palred; RenderPalette; end; 'G' : begin { Toggle green component of palette. } palgreen := not palgreen; RenderPalette; end; 'B' : begin { Toggle blue component of palette. } palblue := not palblue; RenderPalette; end; { Toggle the drawing of triangles, or vertices. } 'T' : triangles := not triangles; 'A' : begin if (smooth or leave) and not blurred then begin smooth := false; leave := false; end; blurred := not blurred; end; 'S' : begin if not smooth and blurred then blurred := false; smooth := not smooth; end; 'L' : begin if (blurred or smooth) and not leave then begin blurred := false; smooth := false; end; leave := not leave; end; end; { Check if the rotation velocities are out of bounds (0..360 degrees) } if (yvel < 0) then yvel := 360 + yvel; if (pvel < 0) then pvel := 360 + pvel; if (rvel < 0) then rvel := 360 + rvel; if (yvel > 360) then yvel := yvel - 360; if (pvel > 360) then pvel := pvel - 360; if (rvel > 360) then rvel := rvel - 360; end; end; { Free the memory used by the sorting bin. } NukeTriangleArray; end; {============================================================================} { Procedure: PrepareObject } { Application: Performs transformations on the object that are necessary } { before the SpinObject procedure is executed. } {============================================================================} procedure PrepareObject; begin writeln('þ Scaling object...'); ScaleObject; writeln('þ Creating triangle sorting bin...'); MakeTriangleArray; writeln('þ Calculating Z Averages...'); CalculateZAverages; end; {============================================================================} { Procedure: NukeLists } { Application: This frees up all the heap memory that the program had } { allocated when loading the mesh file. } {============================================================================} procedure NukeLists; var mesh, meshtmp : t_meshptr; point, pointtmp : t_pointptr; tri, tritmp : t_triptr; begin Writeln('þ Freeing memory...'); { Destroy List of Triangles } tri := t_head; t_head := NIL; while (tri <> NIL) do begin tritmp := tri; tri := tri^.next; dispose(tritmp); end; { Destroy Mesh Headers and Points } mesh := meshes; meshes := NIL; while (mesh <> NIL) do begin point := mesh^.p_head; while (point <> NIL) do begin pointtmp := point; point := point^.next; dispose(pointtmp); end; meshtmp := mesh; mesh := mesh^.next; dispose(meshtmp); end; end; {============================================================================} { Procedure: BeginPrompt } { Application: This procedure prompts the user if they'd like to begin, or } { view the instructions first. If the latter is chosen, } { instructions will be displayed to the screen. } {============================================================================} procedure BeginPrompt; var c : char; begin writeln; write('Press a key to begin, or ''I'' for instructions (NEW STUFF!)...'); c := upcase(readkey); if c = 'I' then begin clrscr; writeln('In-Program Keys:'); writeln('==================================='); writeln(''); writeln('*** THE BASICS: ***'); writeln('8, 4, 2, 6 : Move object Up, Left, Down, or Right, respectively.'); writeln('5, 0 : Move object farther or closer, respectively.'); writeln('Insert/Delete : Increase/Decrease Y-Axis Rotation (Yaw)'); writeln('Home/End : Increase/Decrease X-Axis Rotation (Pitch)'); writeln('Page Up/Page Down : Increase/Decrease Z-Axis Rotation (Roll)'); writeln('+/- : Increase/Decrease amount of rotation per keypress'); writeln('SPACE Bar : Stop all rotation'); writeln('C : Rotate object to origional centered position'); writeln('Up/Down Arrows : Move object farther/closer from/to camera'); writeln('R, G, B : Toggle red/green/blue components of the palette'); writeln('ESC : Quit'); writeln; writeln('*** COOL NEW STUFF: ***'); writeln('S : Toggle Smooth mode (almost anti-aliased)'); writeln('A : Toggle Motion Blur (acid mode)'); writeln('L : Toggle Leave previous image mode (like motion blur, but'); writeln(' with no blur)'); writeln(''); write('Press any key to begin...'); readkey; end; end; {============================================================================} { Function: ExitMessage } { Application: Display any final messages to the user (such as how many } { frames per second the program got). } {============================================================================} procedure ExitMessage; begin writeln('þ Memory used: ', startmem - endmem, ' bytes (64000 video buffer, ', startmem - endmem - 64000, ' object)'); writeln; writeln('Frames per second = ', (framecount * 18.2)/(endtime-starttime):0:2); end; {============================================================================} { MAIN PROGRAM BLOCK } {============================================================================} begin clrscr; { Clear the text screen. } startmem := memavail; { Save the amount of free memory before we start making records. } InitializeGlobals; { Set the global variables to their initial states. } DisplayProgramHeader; { Display copyright/program information. } if LoadMeshFile then begin { Try to load the file that the user passed. } PrepareObject; { Get the object/engine ready to render. } BeginPrompt; { Prompt the user if they want instructions. } InitializeGraphics; { Enter graphics mode and create a virtual screen buffer. } starttime := CPU_Time; { Save the time that we started drawing at. } SpinObject; { Repeatedly draw/rotate the object, looping until the user presses ESC. } endtime := CPU_Time; { Save the time after the program has stopped rendering. } endmem := memavail; { Save how much memory is free after the program has finished rendering. } DeInitializeGraphics; { Return to text mode and deallocate the memory used by the screen buffer. } NukeLists; { Deallocate memory used by the linked lists. } ExitMessage; { Display a text-mode message upon exiting. } end; end. {============================================================================} { END OF PROGRAM } {============================================================================}