home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / BASIC / QBS_0103 / QBS103-5.DOC < prev    next >
Text File  |  1993-04-30  |  35KB  |  1,144 lines
  1. ════════════════════════════════════════════════════════════════════════════════
  2.  Area:    QuickBasic
  3.   Msg:    #5371
  4.  Date:    03-21-93 03:40 (Public)
  5.  From:    RICH GELDREICH
  6.  To:      ALL
  7.  Subject: Solid5 1/8
  8. ────────────────────────────────────────────────────────────────────────────────
  9. Here's the solid 3-D program I've been talking about! Page 1 of 8.
  10.  
  11. 'Page 1 of SOLID5.BAS begins here.
  12. 'Shaded 3-D animation with shadows [solid5.bas] for QB4.5/PDS
  13. 'By Rich Geldreich 1992
  14. 'Notes...
  15. '   This version uses some floating  point math in the initialization
  16. 'code for shading, but after initialization floating point math is not
  17. 'used at all.
  18. '   The  shading  imploys Lambert's Law to determine the intensity of
  19. 'each visible polygon.  Three simple  lookup tables are calculated at
  20. 'initialization time  which  are  used  to  eliminate  multiples  and
  21. 'divides in the main animation code.
  22. '   The hidden face  detection  algorithm  was  made  by Dave Cooper.
  23. 'It's fast, and does not require any multiples and divides under most
  24. 'cases.  The "standard" way of detecting hidden faces, by finding the
  25. 'dot product of the normal of each polygon and  the  viewing  vector,
  26. 'was not just good (or fast) enough for me!
  27. '   The PolyFill routine is the major  bottleneck  of  this  program.
  28. 'QB's  LINE  command isn't as fast as I would like it to be...  On my
  29. '286-10, the speed isn't that bad (after all, this is all-QB!).  On a
  30. '386 or 486, this thing should fly...  [hopefully]
  31. '   The  shadows  are  calculated by projecting a line with the light
  32. 'source's vector through each of the points on the solid.  Where this
  33. 'line hits the ground  plane(which  has  a  constant Y coordinate) is
  34. 'where the new shadow point is plotted.
  35. '   This program is 100% public domain- but  of  course  please  give
  36. 'some credit if you use anything from this program.  Thanks!
  37. DEFINT A-Z
  38. DECLARE SUB CullPolygons ()
  39. DECLARE SUB DrawLine (xs%, ys%, xe%, ye%, EdgeList() AS ANY)
  40. DECLARE SUB DrawObject ()
  41. DECLARE SUB DrawShadows ()
  42. DECLARE SUB EdgeFill (EdgeList() AS ANY, YLow%, YHigh%, C%)
  43. DECLARE SUB FindNormals ()
  44. DECLARE SUB PolyFill (x1%, y1%, x2%, y2%, x3%, y3%, C%)
  45. DECLARE SUB RotatePoints ()
  46. DECLARE SUB ShadePolygons ()
  47.  
  48. CONST True = -1, False = 0
  49.  
  50. TYPE EdgeType              'for fast polygon rasterization
  51.     Low         AS INTEGER
  52.     High        AS INTEGER
  53. END TYPE
  54. TYPE PointType
  55.     XObject     AS INTEGER 'original cooridinate
  56.     YObject     AS INTEGER
  57.     ZObject     AS INTEGER 'rotated coodinated
  58.     XWorld      AS INTEGER
  59.     YWorld      AS INTEGER
  60.     ZWorld      AS INTEGER
  61.     XView       AS INTEGER 'rotated & translated coordinate
  62.  
  63.     YView       AS INTEGER
  64.     XShadow     AS INTEGER 'coordinates projected onto the ground plane
  65.     YShadow     AS INTEGER
  66. END TYPE
  67. TYPE PolyType
  68.     P1          AS INTEGER '3 points which make up the polygon(they _
  69. point
  70.     P2          AS INTEGER ' to the point list array)
  71.     P3          AS INTEGER
  72.     Culled      AS INTEGER 'True if plane not visible
  73.     ZCenter     AS INTEGER 'Z center of polygon
  74.     ZOrder      AS INTEGER 'Used in the shell sort of the ZCenters
  75.     Intensity   AS INTEGER 'Intensity of polygon
  76.     WorldXN     AS INTEGER 'Contains the coordinates of the point
  77.     WorldYN     AS INTEGER ' which is both perpendicular and a constant
  78.     WorldZN     AS INTEGER ' distance from the polygon
  79.     NormalX     AS INTEGER 'Normal of polygon -128 to 128
  80.     NormalY     AS INTEGER ' (used for fast Lambert shading)
  81.     NormalZ     AS INTEGER
  82. END TYPE
  83. TYPE LineType
  84.     P1          AS INTEGER 'Used for shadow projection
  85.     P2          AS INTEGER
  86. END TYPE
  87.  
  88. DIM SHARED EdgeList(199) AS EdgeType
  89. DIM SHARED SineTable(359 + 90) AS LONG 'cos(x)=sin(x+90)
  90. DIM SHARED R1, R2, R3, ox, oy, oz
  91. DIM SHARED MaxPoints, MaxPolys, MaxLines
  92.  
  93. DIM SHARED lines(100) AS LineType
  94. DIM SHARED Polys(100) AS PolyType
  95. DIM SHARED Points(100) AS PointType
  96. DIM SHARED lx(256), ly(256), lz(256)   'lookup tables for Lambert _
  97. shading
  98. DIM SHARED s, XLow(1), XHigh(1), YLow(1), YHigh(1)
  99. DIM SHARED ShadowXLow(1), ShadowXHigh(1), ShadowYLow(1), ShadowYHigh(1)
  100. DIM SHARED lx, ly, lz
  101.  
  102. PRINT "QuickBASIC/PDS 3-D Solid Animation": PRINT "By Rich Geldreich _
  103. 1992"
  104. PRINT : PRINT "Keys: [Turn NUMLOCK on]"
  105. PRINT "Left.....................Angle 1 -"
  106. 'Continued on page 2
  107.  
  108. --- MsgToss 2.0b
  109.  * Origin: Computer Co-Op - Voorhees, NJ | Ted Hare (1:266/29)
  110.  
  111.  
  112.  
  113. ════════════════════════════════════════════════════════════════════════════════
  114.  Area:    QuickBasic
  115.   Msg:    #5372
  116.  Date:    03-21-93 03:41 (Public)
  117.  From:    RICH GELDREICH
  118.  To:      ALL
  119.  Subject: Solid5 2/8
  120. ────────────────────────────────────────────────────────────────────────────────
  121. 'Page 2 of SOLID5.BAS begins here.
  122. PRINT "Right....................Angle 1 +"
  123. PRINT "Up.......................Angle 2 -"
  124. PRINT "Down.....................Angle 2 +"
  125. PRINT "-........................Angle 3 -"
  126. PRINT "+........................Angle 3 +"
  127. PRINT "5........................Rotation Stop"
  128. PRINT "0........................Rotation Reset"
  129. PRINT "Up Arrow.................Forward"
  130. PRINT "Down Arrow...............Backward"
  131. PRINT "Left Arrow...............Left"
  132. PRINT "Right Arrow..............Right"
  133. PRINT : PRINT "Initializing..."
  134.  
  135. MaxPoints = 4  'Pyramid.
  136. 'Points follow...
  137. DATA -100,0,100, -100,0,-100, 100,0,-100, 100,0,100, 0,-290,0
  138. MaxPolys = 5
  139. 'Polygons follow (they must be specified in counterclockwise
  140. 'order for correct hidden face removal and shading)
  141. DATA 4,0,3, 4,3,2, 4,1,0, 4,2,1, 3,0,1, 3,1,2
  142. MaxLines = 7
  143. 'Lines follow for shadow computation...
  144. DATA 4,0, 4,1, 4,2, 4,3, 0,1, 1,2, 2,3, 3,0
  145.  
  146. 'MaxPoints = 7 'Cube.
  147. 'DATA -100,100,100
  148. 'DATA 100,100,100
  149. 'DATA 100,100,-100
  150. 'DATA -100,100,-100
  151. 'DATA -100,-100,100
  152. 'DATA 100,-100,100
  153. 'DATA 100,-100,-100
  154. 'DATA -100,-100,-100
  155. 'MaxPolys = 11
  156. 'DATA 5,4,0, 5,0,1
  157. 'DATA 6,2,3, 3,7,6
  158. 'DATA 6,5,1, 6,1,2
  159. 'DATA 7,0,4, 7,3,0
  160. 'DATA 6,7,4, 6,4,5
  161. 'DATA 0,3,2, 1,0,2
  162. 'MaxLines = 11
  163. 'DATA 0,1, 1,2, 2,3, 3,0
  164. 'DATA 4,5, 5,6, 6,7, 7,4
  165. 'DATA 4,0, 5,1, 6,2, 7,3
  166.  
  167. 'MaxPoints = 15 'Wierd pencil-like shape...
  168. 'DATA 0,0,0, 250,0,0, 400,40,0, 400,60,0, 250,100,0, 0,100,0, _
  169. -20,90,0, -20,10,0
  170. 'DATA 0,0,-50, 250,0,-50, 400,40,-50, 400,60,-50, 250,100,-50, _
  171. 0,100,-50, -20,90,-50, -20,10,-50
  172. 'MaxPolys = 27
  173. 'DATA 1,0,7, 1,7,2, 2,7,6, 2,6,3, 3,6,4, 4,6,5
  174.  
  175. 'DATA 9,15,8, 9,10,15, 10,14,15, 10,11,14, 11,13,14, 11,12,13
  176. 'DATA 8,7,0, 8,15,7, 8,0,1, 9,8,1, 9,1,2, 10,9,2, 10,2,3, 11,10,3
  177. 'DATA 12,11,4, 11,3,4, 4,5,13, 4,13,12
  178. 'DATA 5,6,14, 5,14,13, 14,6,7, 14,7,15
  179. 'MaxLines = 23
  180. 'DATA 0,1, 1,2, 2,3, 3,4, 4,5, 5,6, 6,7, 7,0
  181. 'DATA 8,9, 9,10, 10,11, 11,12, 12,13, 13,14, 14,15, 15,0
  182. 'DATA 0,8, 1,9, 2,10, 3,11, 4,12, 5,13, 6,14, 7,15
  183.  
  184. FOR a = 0 TO MaxPoints
  185.     READ Points(a).XObject, Points(a).YObject, Points(a).ZObject
  186.     X = X + Points(a).XObject: Y = Y + Points(a).YObject: Z = Z + _
  187. Points(a).ZObject
  188. NEXT
  189. 'Center the object
  190. X = X \ (MaxPoints + 1): Y = Y \ (MaxPoints + 1): Z = Z \ (MaxPoints +
  191. _
  192. 1)
  193. FOR a = 0 TO MaxPoints
  194.     Points(a).XObject = Points(a).XObject - X
  195.     Points(a).YObject = Points(a).YObject - Y
  196.     Points(a).ZObject = Points(a).ZObject - Z
  197. NEXT
  198. FOR a = 0 TO MaxPolys
  199.     READ Polys(a).P1, Polys(a).P2, Polys(a).P3
  200. NEXT
  201. FOR a = 0 TO MaxLines
  202.     READ lines(a).P1, lines(a).P2
  203. NEXT
  204.  
  205. 'Precalculate the normal point of each polygon for fast Lambert shading
  206. FindNormals
  207.  
  208. 'Precalculate the sine table
  209. a = 0
  210. FOR a! = 0 TO (359 + 90) / 57.29 STEP 1 / 57.29
  211.     SineTable(a) = SIN(a!) * 1024: a = a + 1
  212. NEXT
  213.  
  214. 'Some light source configurations won't work that great!
  215. l1 = 70: l2 = 40           'light source's spherical coordinates
  216. a1! = l1 / 57.29: a2! = l2 / 57.29
  217. 'Continued on page 3
  218.  
  219. --- MsgToss 2.0b
  220.  * Origin: Computer Co-Op - Voorhees, NJ | Ted Hare (1:266/29)
  221.  
  222.  
  223.  
  224. ════════════════════════════════════════════════════════════════════════════════
  225.  Area:    QuickBasic
  226.   Msg:    #5373
  227.  Date:    03-21-93 03:41 (Public)
  228.  From:    RICH GELDREICH
  229.  To:      ALL
  230.  Subject: Solid5 3/8
  231. ────────────────────────────────────────────────────────────────────────────────
  232. 'Page 3 of SOLID5.BAS begins here.
  233. s1! = SIN(a1!): c1! = COS(a1!)
  234. s2! = SIN(a2!): c2! = COS(a2!)
  235. lx = 128 * s1! * c2!        'convert spherical coordinates to a vector
  236. ly = 128 * s1! * s2!        'scale up by 128 for integer math
  237. lz = 128 * c1!
  238.  
  239. FOR a = -128 TO 128         'precalculate the three light source tables
  240.     lx(a + 128) = lx * a    'for fast Lambert shading
  241.     ly(a + 128) = ly * a
  242.     lz(a + 128) = lz * a
  243. NEXT
  244.  
  245. PRINT "Strike a key...": DO: LOOP WHILE INKEY$ = ""
  246.  
  247. R1 = 0: R2 = 0: R3 = 0      'three angles of rotation
  248. ox = 0: oy = -50: oz = 1100 'object's origin (this program cannot _
  249. currently
  250.                             'handle the object when it goes behind the
  251. _
  252. viewer!)
  253. s = 1: t = 0
  254.  
  255. SCREEN 7, , 0, 0
  256. OUT &H3C8, 0                'set 16 shades
  257. FOR a = 0 TO 15
  258.     OUT &H3C9, (a * 34) \ 10
  259.     OUT &H3C9, (a * 212) \ 100
  260.     OUT &H3C9, (a * 4) \ 10
  261.     IF a = 7 THEN OUT &H3C7, 16: OUT &H3C8, 16
  262. NEXT
  263. LINE (0, 100)-(319, 199), 9, BF
  264. LINE (0, 0)-(319, 99), 3, BF
  265. SCREEN 7, , 1, 0
  266. LINE (0, 100)-(319, 199), 9, BF
  267. LINE (0, 0)-(319, 99), 3, BF
  268.  
  269. YHigh(0) = -32768: ShadowYHigh(0) = -32768
  270. YHigh(1) = -32768: ShadowYHigh(1) = -32768
  271. DO
  272.     'Flip active and work pages so user doesn't see our messy drawing
  273.     SCREEN 7, , s, t: SWAP s, t
  274.  
  275.     'Wait for vertical retrace to reduce flicker
  276.     WAIT &H3DA, 8
  277.  
  278.     'Erase the old image from the screen
  279.     IF YHigh(s) <> -32768 THEN
  280.         IF YHigh(s) < 100 THEN
  281.             LINE (XLow(s), YLow(s))-(XHigh(s), YHigh(s)), 3, BF
  282.         ELSEIF YLow(s) < 100 THEN
  283.             LINE (XLow(s), YLow(s))-(XHigh(s), 99), 3, BF
  284.             LINE (XLow(s), 100)-(XHigh(s), YHigh(s)), 9, BF
  285.  
  286.         ELSE
  287.             LINE (XLow(s), YLow(s))-(XHigh(s), YHigh(s)), 9, BF
  288.         END IF
  289.     END IF
  290.     IF ShadowYHigh(s) <> -32768 THEN
  291.         LINE (ShadowXLow(s), ShadowYLow(s))-(ShadowXHigh(s), ShadowYHig_
  292. h(s)), 9, BF
  293.     END IF
  294.     RotatePoints
  295.     CullPolygons
  296.     ShadePolygons
  297.  
  298.     XLow(s) = 32767: XHigh(s) = -32768
  299.     YLow(s) = 32767: YHigh(s) = -32768
  300.     DrawShadows
  301.     DrawObject
  302.  
  303.     R1 = (R1 + D1) MOD 360: IF R1 < 0 THEN R1 = R1 + 360
  304.     R2 = (R2 + D2) MOD 360: IF R2 < 0 THEN R2 = R2 + 360
  305.     R3 = (R3 + D3) MOD 360: IF R3 < 0 THEN R3 = R3 + 360
  306.     oz = oz + dz: ox = ox + dx
  307.     IF oz < 600 THEN
  308.         oz = 600: dz = 0
  309.     ELSEIF oz > 8000 THEN
  310.         oz = 8000: dz = 0
  311.     END IF
  312.     IF ox < -4000 THEN
  313.         ox = -4000: dx = 0
  314.     ELSEIF ox > 4000 THEN
  315.         ox = 4000: dx = 0
  316.     END IF
  317.     a$ = INKEY$
  318.     SELECT CASE a$
  319.     CASE "4"
  320.         D1 = D1 - 2
  321.     CASE "6"
  322.         D1 = D1 + 2
  323.     CASE "8"
  324.         D2 = D2 - 2
  325.     CASE "2"
  326.         D2 = D2 + 2
  327.     CASE "5"
  328. 'Continued on page 4
  329.  
  330. --- MsgToss 2.0b
  331.  * Origin: Computer Co-Op - Voorhees, NJ | Ted Hare (1:266/29)
  332.  
  333.  
  334.  
  335. ════════════════════════════════════════════════════════════════════════════════
  336.  Area:    QuickBasic
  337.   Msg:    #5374
  338.  Date:    03-21-93 03:42 (Public)
  339.  From:    RICH GELDREICH
  340.  To:      ALL
  341.  Subject: Solid5 4/8
  342. ────────────────────────────────────────────────────────────────────────────────
  343. 'Page 4 of SOLID5.BAS begins here.
  344.         D1 = 0: D2 = 0: D3 = 0
  345.     CASE "0"
  346.         R1 = 0: R2 = 0: R3 = 0
  347.         D1 = 0: D2 = 0: D3 = 0
  348.     CASE "+"
  349.         D3 = D3 + 2
  350.     CASE "-"
  351.         D3 = D3 - 2
  352.     CASE CHR$(27)
  353.         END
  354.     CASE CHR$(0) + CHR$(72)
  355.         dz = dz - 20
  356.     CASE CHR$(0) + CHR$(80)
  357.         dz = dz + 20
  358.     CASE CHR$(0) + CHR$(77)
  359.         dx = dx - 20
  360.     CASE CHR$(0) + CHR$(75)
  361.         dx = dx + 20
  362.     END SELECT
  363. LOOP
  364.  
  365. '"Culls" the polygons which aren't visible to the viewer. Also shades
  366. 'each polygon using Lambert's law.
  367. SUB CullPolygons
  368.     'This algorithm for removing hidden faces was developed by Dave _
  369. Cooper.
  370.     'There is another method, by finding the dot product of the
  371.     'plane's normal and the viewing vector, but this algorithm is
  372.     'much faster because of its simplicity(and lack of floating point
  373.     'calculations).
  374.     FOR a = 0 TO MaxPolys
  375.         P1 = Polys(a).P1
  376.         P2 = Polys(a).P2
  377.         P3 = Polys(a).P3
  378.  
  379.         IF Points(P1).YView <= Points(P2).YView THEN
  380.             IF Points(P3).YView < Points(P1).YView THEN
  381.                 PTop = P3
  382.                 PNext = P1
  383.                 PLast = P2
  384.             ELSE
  385.                 PTop = P1
  386.                 PNext = P2
  387.                 PLast = P3
  388.             END IF
  389.         ELSE
  390.             IF Points(P3).YView < Points(P2).YView THEN
  391.                 PTop = P3
  392.                 PNext = P1
  393.                 PLast = P2
  394.             ELSE
  395.                 PTop = P2
  396.  
  397.                 PNext = P3
  398.                 PLast = P1
  399.             END IF
  400.         END IF
  401.  
  402.         XLow = Points(PTop).XView
  403.         YLow = Points(PTop).YView
  404.  
  405.         XNext = Points(PNext).XView
  406.         XLast = Points(PLast).XView
  407.  
  408.         IF XNext <= XLow AND XLast >= XLow THEN
  409.             Polys(a).Culled = True
  410.         ELSEIF XNext >= XLow AND XLast <= XLow THEN
  411.             Polys(a).Culled = False
  412.         ELSE
  413.             YNext = Points(PNext).YView
  414.             YLast = Points(PLast).YView
  415.             IF ((YNext - YLow) * 256&) \ (XNext - XLow) < ((YLast - _
  416. YLow) * 256&) \ (XLast - XLow) THEN
  417.                 Polys(a).Culled = False
  418.             ELSE
  419.                 Polys(a).Culled = True
  420.             END IF
  421.         END IF
  422.  
  423.     NEXT
  424. END SUB
  425.  
  426. 'Enters a line into the edge list. For each scan line, the line's
  427. 'X coordinate is found. Notice the lack of floating point math in this
  428. 'subroutine.
  429. SUB DrawLine (xs, ys, xe, ye, EdgeList() AS EdgeType)
  430.  
  431.     IF ys > ye THEN SWAP xs, xe: SWAP ys, ye
  432.  
  433.     IF ye < 0 OR ys > 199 THEN EXIT SUB
  434.  
  435.     IF ys < 0 THEN
  436.         xs = xs + ((xe - xs) * -ys) \ (ye - ys)
  437.         ys = 0
  438. 'Continued on page 5
  439.  
  440. --- MsgToss 2.0b
  441.  * Origin: Computer Co-Op - Voorhees, NJ | Ted Hare (1:266/29)
  442.  
  443.  
  444.  
  445. ════════════════════════════════════════════════════════════════════════════════
  446.  Area:    QuickBasic
  447.   Msg:    #5375
  448.  Date:    03-21-93 03:43 (Public)
  449.  From:    RICH GELDREICH
  450.  To:      ALL
  451.  Subject: Solid5 5/8
  452. ────────────────────────────────────────────────────────────────────────────────
  453. 'Page 5 of SOLID5.BAS begins here.
  454.     END IF
  455.  
  456.     xd = xe - xs
  457.     yd = ye - ys
  458.  
  459.     IF yd <> 0 THEN xi = xd \ yd: xrs = ABS(xd MOD yd)
  460.  
  461.     xr = -yd \ 2
  462.  
  463.     IF ye > 199 THEN ye = 199
  464.  
  465.     xdirect = SGN(xd) + xi
  466.  
  467.     FOR Y = ys TO ye
  468.         IF xs < EdgeList(Y).Low THEN EdgeList(Y).Low = xs
  469.         IF xs > EdgeList(Y).High THEN EdgeList(Y).High = xs
  470.  
  471.         xr = xr + xrs
  472.         IF xr > 0 THEN
  473.             xr = xr - yd
  474.             xs = xs + xdirect
  475.         ELSE
  476.             xs = xs + xi
  477.         END IF
  478.     NEXT
  479.  
  480. END SUB
  481.  
  482. SUB DrawObject
  483.  
  484.     'Find the center of each visible polygon, and prepare the order _
  485. list.
  486.     NumPolys = 0
  487.     FOR a = 0 TO MaxPolys
  488.         IF Polys(a).Culled = False THEN 'is this polygon visible?
  489.             Polys(NumPolys).ZOrder = a
  490.             NumPolys = NumPolys + 1
  491.             Polys(a).ZCenter = Points(Polys(a).P1).ZWorld + Points(Poly_
  492. s(a).P2).ZWorld + Points(Polys(a).P3).ZWorld
  493.         END IF
  494.     NEXT
  495.     'Sort the visible polygons by their Z center using a shell sort.
  496.     NumPolys = NumPolys - 1
  497.     Mid = (NumPolys + 1) \ 2
  498.     DO
  499.         FOR a = 0 TO NumPolys - Mid
  500.             CompareLow = a
  501.             CompareHigh = a + Mid
  502.             DO WHILE Polys(Polys(CompareLow).ZOrder).ZCenter < _
  503. Polys(Polys(CompareHigh).ZOrder).ZCenter
  504.                 SWAP Polys(CompareLow).ZOrder, Polys(CompareHigh).ZOrder
  505.                 CompareHigh = CompareLow
  506.  
  507.                 CompareLow = CompareLow - Mid
  508.                 IF CompareLow < 0 THEN EXIT DO
  509.             LOOP
  510.         NEXT
  511.         Mid = Mid \ 2
  512.     LOOP WHILE Mid > 0
  513.     'Plot the visible polygons.
  514.     FOR Z = 0 TO NumPolys
  515.         a = Polys(Z).ZOrder 'which polygon do we plot?
  516.         P1 = Polys(a).P1: P2 = Polys(a).P2: P3 = Polys(a).P3
  517.         PolyFill (Points(P1).XView), (Points(P1).YView), (Points(P2).XV_
  518. iew), (Points(P2).YView), (Points(P3).XView), (Points(P3).YView), _
  519. (Polys(a).Intensity)
  520.     NEXT
  521. END SUB
  522.  
  523. SUB DrawShadows
  524.     YLow = 32767: YHigh = -32768
  525.     XLow = 32767: XHigh = -32768
  526.     FOR a = 0 TO MaxPoints
  527.         'Project the 3-D point onto the ground plane...
  528.         temp& = (Points(a).YWorld - 200)
  529.         X = Points(a).XWorld - (temp& * lx) \ ly
  530.         Y = 200 'ground plane has a constant Y coordinate
  531.         Z = Points(a).ZWorld - (temp& * lz) \ ly
  532.         'Put the point into perspective
  533.         xTemp = 160 + (X * 400&) \ Z
  534.         yTemp = 100 + (Y * 300&) \ Z
  535.  
  536.         Points(a).XShadow = xTemp
  537.         Points(a).YShadow = yTemp
  538.  
  539.         'Find the lowest & highest X Y coordinates
  540.         IF yTemp < YLow THEN YLow = yTemp
  541.         IF yTemp > YHigh THEN YHigh = yTemp
  542.         IF xTemp < XLow THEN XLow = xTemp
  543.         IF xTemp > XHigh THEN XHigh = xTemp
  544.     NEXT
  545.  
  546.     'Store lowest & highest coordinates for later erasing...
  547.     ShadowXLow(s) = XLow: ShadowYLow(s) = YLow
  548. 'Continued on page 6
  549.  
  550. --- MsgToss 2.0b
  551.  * Origin: Computer Co-Op - Voorhees, NJ | Ted Hare (1:266/29)
  552.  
  553.  
  554.  
  555. ════════════════════════════════════════════════════════════════════════════════
  556.  Area:    QuickBasic
  557.   Msg:    #5376
  558.  Date:    03-21-93 03:44 (Public)
  559.  From:    RICH GELDREICH
  560.  To:      ALL
  561.  Subject: Solid5 6/8
  562. ────────────────────────────────────────────────────────────────────────────────
  563. 'Page 6 of SOLID5.BAS begins here.
  564.     ShadowXHigh(s) = XHigh: ShadowYHigh(s) = YHigh
  565.     IF XHigh < 0 OR XLow > 319 OR YLow > 199 OR YHigh < 0 THEN EXIT SUB
  566.     IF YHigh > 199 THEN YHigh = 199
  567.     IF YLow < 0 THEN YLow = 0
  568.  
  569.     'Initialize the edge list
  570.     FOR a = YLow TO YHigh
  571.         EdgeList(a).Low = 32767
  572.         EdgeList(a).High = -32768
  573.     NEXT
  574.  
  575.     'Enter the lines into the edge list
  576.     FOR a = 0 TO MaxLines
  577.         P1 = lines(a).P1
  578.         P2 = lines(a).P2
  579.         DrawLine (Points(P1).XShadow), (Points(P1).YShadow), (Points(P2_
  580. ).XShadow), (Points(P2).YShadow), EdgeList()
  581.         'LINE ((Points(P1).XShadow), (Points(P1).YShadow))-((Points(P2)_
  582. .XShadow), (Points(P2).YShadow)), 0
  583.     NEXT
  584.  
  585.     'Fill the polygon
  586.     EdgeFill EdgeList(), YLow, YHigh, 3
  587.  
  588. END SUB
  589.  
  590. SUB EdgeFill (EdgeList() AS EdgeType, YLow, YHigh, C)
  591.     FOR a = YLow TO YHigh
  592.         LINE (EdgeList(a).Low, a)-(EdgeList(a).High, a), C
  593.     NEXT
  594. END SUB
  595.  
  596. 'This routine initializes the data required by the fast Lambert shading
  597. 'algorithm. It calculates the point which is both perpendicular
  598. 'and a constant distance from each polygon and stores it. This point
  599. 'is then rotated with the rest of the points. When it comes time for
  600. 'shading, the normal to the polygon is looked up in a simple lookup
  601. 'table for maximum speed.
  602. SUB FindNormals
  603.     FOR a = 0 TO MaxPolys
  604.         P1 = Polys(a).P1: P2 = Polys(a).P2: P3 = Polys(a).P3
  605.  
  606.         'find the vectors of 2 lines inside the polygon
  607.         ax! = Points(P2).XObject - Points(P1).XObject
  608.         ay! = Points(P2).YObject - Points(P1).YObject
  609.         az! = Points(P2).ZObject - Points(P1).ZObject
  610.  
  611.         bx! = Points(P3).XObject - Points(P2).XObject
  612.         by! = Points(P3).YObject - Points(P2).YObject
  613.         bz! = Points(P3).ZObject - Points(P2).ZObject
  614.  
  615.         'find the cross product of the 2 vectors
  616.  
  617.         nx! = ay! * bz! - az! * by!
  618.         ny! = az! * bx! - ax! * bz!
  619.         nz! = ax! * by! - ay! * bx!
  620.  
  621.         'normalize the vector so it ranges from -1 to 1
  622.         M! = SQR(nx! * nx! + ny! * ny! + nz! * nz!)
  623.         IF M! <> 0 THEN nx! = nx! / M!: ny! = ny! / M!: nz! = nz! / M!
  624.         'store the vector for later rotation(notice that it is scaled
  625.         'up by 128 so it can be stored as an integer variable)
  626.         Polys(a).WorldXN = nx! * 128 + Points(P1).XObject
  627.         Polys(a).WorldYN = ny! * 128 + Points(P1).YObject
  628.         Polys(a).WorldZN = nz! * 128 + Points(P1).ZObject
  629.     NEXT
  630. END SUB
  631.  
  632. 'Draws a polygon to the screen. Simply finds the start and stop X
  633. 'coordinates for each scan line within the polygon and uses the
  634. 'LINE command for filling.
  635. SUB PolyFill (x1, y1, x2, y2, x3, y3, C) 'for QB 4.5 guys
  636.  
  637.     'find lowest and high X & Y coordinates
  638.     IF y1 < y2 THEN YLow = y1 ELSE YLow = y2
  639.     IF y3 < YLow THEN YLow = y3
  640.     IF y1 > y2 THEN YHigh = y1 ELSE YHigh = y2
  641.     IF y3 > YHigh THEN YHigh = y3
  642.  
  643.     IF x1 < x2 THEN XLow = x1 ELSE XLow = x2
  644.     IF x3 < XLow THEN XLow = x3
  645.     IF x1 > x2 THEN XHigh = x1 ELSE XHigh = x2
  646.     IF x3 > XHigh THEN XHigh = x3
  647.  
  648.     IF YLow < 0 THEN YLow = 0
  649.  
  650.     IF YHigh > 199 THEN YHigh = 199
  651.  
  652.     IF XLow < XLow(s) THEN XLow(s) = XLow
  653.     IF XHigh > XHigh(s) THEN XHigh(s) = XHigh
  654.  
  655.     IF YLow < YLow(s) THEN YLow(s) = YLow
  656.     IF YHigh > YHigh(s) THEN YHigh(s) = YHigh
  657.  
  658. 'Continued on page 7
  659.  
  660. --- MsgToss 2.0b
  661.  * Origin: Computer Co-Op - Voorhees, NJ | Ted Hare (1:266/29)
  662.  
  663.  
  664.  
  665. ════════════════════════════════════════════════════════════════════════════════
  666.  Area:    QuickBasic
  667.   Msg:    #5377
  668.  Date:    03-21-93 03:44 (Public)
  669.  From:    RICH GELDREICH
  670.  To:      ALL
  671.  Subject: Solid5 7/8
  672. ────────────────────────────────────────────────────────────────────────────────
  673. 'Page 7 of SOLID5.BAS begins here.
  674.     'check for polygons which cannot be visible
  675.     IF YHigh < 0 OR YLow > 199 OR XLow > 319 OR XHigh < 0 THEN EXIT SUB
  676.  
  677.     'initialize the edge list
  678.     FOR a = YLow TO YHigh
  679.         EdgeList(a).Low = 32767
  680.         EdgeList(a).High = -32768
  681.     NEXT
  682.  
  683.     'Remember the lowest & highest X and Y coordinates drawn to the
  684.     'screen for later erasing
  685.  
  686.     'Find the start and stop X coodinates for each scan line
  687.     DrawLine (x1), (y1), (x2), (y2), EdgeList()
  688.     DrawLine (x2), (y2), (x3), (y3), EdgeList()
  689.     DrawLine (x3), (y3), (x1), (y1), EdgeList()
  690.     EdgeFill EdgeList(), YLow, YHigh, C
  691.  
  692. END SUB
  693.  
  694. 'Rotates the points of the object and the object's normals.
  695. 'Avoids floating point math for speed.
  696. SUB RotatePoints
  697.  
  698.     'lookup the sine and cosine of each angle...
  699.     s1& = SineTable(R1): c1& = SineTable(R1 + 90)
  700.     s2& = SineTable(R2): c2& = SineTable(R2 + 90)
  701.     s3& = SineTable(R3): c3& = SineTable(R3 + 90)
  702.  
  703.     'rotate the points of the object
  704.     FOR a = 0 TO MaxPoints
  705.         xo = Points(a).XObject
  706.         yo = Points(a).YObject
  707.         zo = Points(a).ZObject
  708.         GOSUB Rotate3D
  709.  
  710.         Points(a).XView = 160 + (x2 * 400&) \ z3
  711.         Points(a).YView = 100 + (y3 * 300&) \ z3
  712.         'IF y3 > 300 THEN STOP
  713.  
  714.         Points(a).XWorld = x2
  715.         Points(a).YWorld = y3
  716.         Points(a).ZWorld = z3
  717.     NEXT
  718.     'rotate the normals of each polygon...
  719.     FOR a = 0 TO MaxPolys
  720.         xo = Polys(a).WorldXN
  721.         yo = Polys(a).WorldYN
  722.         zo = Polys(a).WorldZN
  723.         GOSUB Rotate3D
  724.         P1 = Polys(a).P1
  725.         'unorigin the point
  726.  
  727.         x2 = x2 - Points(P1).XWorld
  728.         y3 = y3 - Points(P1).YWorld
  729.         z3 = z3 - Points(P1).ZWorld
  730.         'check the bounds just in case of a round off error
  731.         IF x2 < -128 THEN x2 = -128 ELSE IF x2 > 128 THEN x2 = 128
  732.         IF y3 < -128 THEN y3 = -128 ELSE IF y3 > 128 THEN y3 = 128
  733.         IF z3 < -128 THEN z3 = -128 ELSE IF z3 > 128 THEN z3 = 128
  734.         'store the normal back; it's now ready for the shading
  735.         'calculations (which are simplistic now)
  736.         Polys(a).NormalX = x2 + 128
  737.         Polys(a).NormalY = y3 + 128
  738.         Polys(a).NormalZ = z3 + 128
  739.     NEXT
  740.     EXIT SUB
  741.  
  742. Rotate3D:
  743.     x1 = (xo * c1& - zo * s1&) \ 1024 'yaw
  744.     z1 = (xo * s1& + zo * c1&) \ 1024
  745.  
  746.     z3 = (z1 * c3& - yo * s3&) \ 1024 + oz 'pitch
  747.     y2 = (z1 * s3& + yo * c3&) \ 1024
  748.  
  749.     x2 = (x1 * c2& + y2 * s2&) \ 1024 + ox 'roll
  750.     y3 = (y2 * c2& - x1 * s2&) \ 1024 + oy
  751.  
  752. RETURN
  753. END SUB
  754.  
  755. 'Shades the polygons using Lambert shading. Notice the total lack of
  756. 'floating point math- only 1 divide is required for each polygon shaded.
  757. '(This divide can be eliminated, but the shading won't be as accurate.)
  758. SUB ShadePolygons
  759.     FOR a = 0 TO MaxPolys
  760.         IF Polys(a).Culled = False THEN
  761.          'lookup the polygon's normal for shading
  762.          '(128*128)\15 = 1092
  763.          Intensity = (lx(Polys(a).NormalX) + ly(Polys(a).NormalY) + _
  764. lz(Polys(a).NormalZ)) \ 1092
  765.          IF Intensity < 0 THEN Intensity = 0
  766.          Intensity = Intensity + 5
  767.          IF Intensity > 15 THEN Intensity = 15
  768. 'Continued on page 8
  769.  
  770. --- MsgToss 2.0b
  771.  * Origin: Computer Co-Op - Voorhees, NJ | Ted Hare (1:266/29)
  772.  
  773.  
  774.  
  775. ════════════════════════════════════════════════════════════════════════════════
  776.  Area:    QuickBasic
  777.   Msg:    #5378
  778.  Date:    03-21-93 03:47 (Public)
  779.  From:    RICH GELDREICH
  780.  To:      ALL
  781.  Subject: Solid5 8/8
  782. ────────────────────────────────────────────────────────────────────────────────
  783. 'Page 8 of SOLID5.BAS begins here.
  784.          Polys(a).Intensity = Intensity
  785.         END IF
  786.     NEXT
  787. END SUB
  788.  
  789.     That's all! Don't just capture the 8 messages and load them into the
  790. QB environment, the lines don't get put together correctly(I'll have to
  791. use MSGSPLIT or PostIt next time). Load it into a text editor and put it
  792. together yourself.
  793.  
  794.     The program should work in all flavors of basic.
  795.  
  796.     Rich
  797.  
  798. --- MsgToss 2.0b
  799.  * Origin: Computer Co-Op - Voorhees, NJ | Ted Hare (1:266/29)
  800.  
  801.  
  802.  
  803. ════════════════════════════════════════════════════════════════════════════════
  804.  Area:    QuickBasic
  805.   Msg:    #5895
  806.  Date:    03-21-93 12:33 (Public)
  807.  From:    JEFF FREEMAN
  808.  To:      QUINN TYLER JACKSON
  809.  Subject: ANSI0001.BAS 1/3
  810. ────────────────────────────────────────────────────────────────────────────────
  811. Quinn,
  812.     Looks like this is it.  I also added a check for if the ANSI is
  813. supported, and also if ANSI MUSIC is supported, but if you don't want them
  814. they are easily removed.  Also supports either PLAY or MUSIC.
  815. '________O_/________________________| SNIP | ______________________\_O_______
  816. '        O \                        | HERE |                       / O
  817. 'This file created by PostIt! v5.1.
  818. '>>> Start of page 1.
  819.  
  820. DECLARE SUB sjfParse (Word$(), Txt$, Spt$, NumWords%)
  821. DECLARE FUNCTION fjfTOANSI$ (Cmnd$)
  822. DECLARE FUNCTION Txt2Ansi% (Txt$, Ansi$)
  823. DECLARE FUNCTION sjfTOANSI$ (Cmnd$)
  824. DEFINT A-Z
  825.  
  826.   'Load ANSI.SYS and execute this program to view @-commands
  827.   ' translated to ANSI
  828.   'The music will not be heard unless your ANSI.SYS driver
  829.   ' supports ANSI music.  Ha.
  830.  
  831.   OPEN "cons:" FOR OUTPUT AS #1
  832.  
  833.   X = Txt2Ansi("@CLS;Down:9;fore:yellow,bold@This"+_
  834. " @Fore:blink,bold,white;Back:blue@is really@fore"+_
  835. ":green,bold;back:black@ neat!@fore:white,bold;back:black;locate:12,10@"+_
  836. " using @@-commands@fore:white@!@PLAY:efabcd@", Ansi$)
  837.   PRINT #1, Ansi$
  838.  
  839.   'valid commands are:
  840.  
  841.   'CLS                - Clears the screen
  842.   'FORE:color,attrib  - Sets foreground color, BLINK and/or BOLD
  843.   'BACK:color         - Sets background color
  844.   'UP:xx              - moves the cursor xx spaces
  845.   'DOWN:xx
  846.   'RIGHT:xx
  847.   'LEFT:xx
  848.   'LOCATE:row,column  - move cursor to row,column
  849.   'EOL                - erase to end of line
  850.   'SAVE               - save cursor position.
  851.   'RESTORE            - restore cursor position.
  852.   'PLAY:abcdef
  853.   ' or MUSIC:abcdef   - Play Music
  854.  
  855. END
  856.  
  857. '
  858. ' Format of CmndLine$ is:
  859. '     @command:parameter@
  860. '
  861. ' multiple parameters:
  862. '     @command:parm,parm@
  863. '
  864.  
  865. ' multiple commands:
  866. '     @command:parm,parm;command;command:parm@
  867. '
  868. '     ***There are no spaces in CmndLine$***
  869. '
  870. FUNCTION fjfTOANSI$ (CmndLine$)
  871.  
  872.   'ON LOCAL ERROR GOTO BadCmndLine
  873.  
  874.   AnsiMusicIsSupported = -1
  875.   'change this to a global/user-record variable to
  876.   ' indicate whether or not ANSI Music is supported
  877.  
  878.   AnsiIsSupported = -1
  879.   'change this to a global/user-record variable to
  880.   ' indicate whether or not ANSI is supported
  881.  
  882.  
  883.   'return @ if passed @@
  884.   IF CmndLine$ = "@@" THEN
  885.     fjfTOANSI$ = "@"
  886.     EXIT FUNCTION
  887.   END IF
  888.   IF CmndLine$ = "" THEN EXIT FUNCTION
  889.   IF NOT AnsiIsSupported THEN
  890.     fjfTOANSI$ = ""
  891.     EXIT FUNCTION
  892.   END IF
  893.  
  894.  
  895.   'strip the leading and trailing @'s
  896.   CmndLine$ = MID$(CmndLine$, 2, LEN(CmndLine$) - 2)
  897.  
  898.   DIM Cmnds$(9), Params$(9):  Out$ = ""
  899.  
  900.   'put each command in a separate Cmnds$()
  901.   sjfParse Cmnds$(), CmndLine$, ";", NumCmnds
  902.  
  903. '>>> Continued on page 2.
  904.  
  905. ---
  906.  * Origin: WarWorld's point away from home... (1:124/7006.1)
  907.  
  908.  
  909.  
  910. ════════════════════════════════════════════════════════════════════════════════
  911.  Area:    QuickBasic
  912.   Msg:    #5896
  913.  Date:    03-21-93 12:33 (Public)
  914.  From:    JEFF FREEMAN
  915.  To:      QUINN TYLER JACKSON
  916.  Subject: ANSI0001.BAS 2/3
  917. ────────────────────────────────────────────────────────────────────────────────
  918. '>>> Start of page 2.
  919.  
  920.   FOR CmndNum = 1 TO NumCmnds
  921.     'separate the command from the Params$
  922.     sjfParse Params$(), Cmnds$(CmndNum), ":", NumParams
  923.     Cmnd$ = UCASE$(Params$(1)): ListParams$ = Params$(2)
  924.  
  925.     'put each Param in a separate Params$()
  926.     sjfParse Params$(), ListParams$, ",", NumParm
  927.     Out$ = Out$ + CHR$(27) + "["
  928.  
  929.     SELECT CASE Cmnd$
  930.       CASE IS = "FORE"
  931.         Out$ = Out$ + "0"
  932.         FOR Parm = 1 TO NumParm
  933.           SELECT CASE UCASE$(Params$(Parm))
  934.             CASE "BOLD": Out$ = Out$ + ";1"
  935.             CASE "BLINK": Out$ = Out$ + ";5"
  936.             CASE "BLACK": Out$ = Out$ + ";30"
  937.             CASE "RED": Out$ = Out$ + ";31"
  938.             CASE "GREEN": Out$ = Out$ + ";32"
  939.             CASE "YELLOW", "BROWN": Out$ = Out$ + ";33"
  940.             CASE "BLUE": Out$ = Out$ + ";34"
  941.             CASE "MAGENTA", "PURPLE": Out$ = Out$ + ";35"
  942.             CASE "CYAN": Out$ = Out$ + ";36"
  943.             CASE "WHITE": Out$ = Out$ + ";37"
  944.           END SELECT
  945.         NEXT Parm
  946.         Out$ = Out$ + "m"
  947.       CASE "BACK"
  948.         SELECT CASE UCASE$(Params$(1))
  949.             CASE "BLACK"
  950.               Out$ = Out$ + "40"
  951.             CASE "RED"
  952.               Out$ = Out$ + "41"
  953.             CASE "GREEN"
  954.               Out$ = Out$ + "42"
  955.             CASE "YELLOW", "BROWN"
  956.               Out$ = Out$ + "43"
  957.             CASE "BLUE"
  958.               Out$ = Out$ + "44"
  959.             CASE "MAGENTA", "PURPLE"
  960.               Out$ = Out$ + "45"
  961.             CASE "CYAN"
  962.               Out$ = Out$ + "46"
  963.             CASE "WHITE"
  964.               Out$ = Out$ + "47"
  965.         END SELECT
  966.         Out$ = Out$ + "m"
  967.       CASE "CLS"
  968.         Out$ = Out$ + "2J"
  969.       CASE "UP"
  970.         Out$ = Out$ + Params$(1) + "A"
  971.  
  972.       CASE "DOWN"
  973.         Out$ = Out$ + Params$(1) + "B"
  974.       CASE "RIGHT"
  975.         Out$ = Out$ + Params$(1) + "C"
  976.       CASE "LEFT"
  977.         Out$ = Out$ + Params$(1) + "D"
  978.       CASE "LOCATE"
  979.         Out$ = Out$ + Params$(1) + ";" + Params$(2) + "H"
  980.       CASE "EOL"
  981.         Out$ = Out$ + "K"
  982.       CASE "SAVE"
  983.         Out$ = Out$ + "s"
  984.       CASE "RESTORE"
  985.         Out$ = Out$ + "u"
  986.       CASE "PLAY", "MUSIC"
  987.         IF AnsiMusicIsSupported THEN
  988.           Out$ = Out$ + Params$(1) + CHR$(14)
  989.         ELSE
  990.           Out$ = ""
  991.         END IF
  992.       CASE ELSE: Out$ = ""
  993.     END SELECT
  994.  
  995.   NEXT CmndNum
  996.  
  997.   fjfTOANSI$ = Out$
  998.  
  999.   EXIT FUNCTION
  1000.  
  1001. BadCmndLine:
  1002.  
  1003.   fjfTOANSI$ = ""
  1004.  
  1005. END FUNCTION
  1006.  
  1007. '>>> Continued on page 3.
  1008.  
  1009. ---
  1010.  * Origin: WarWorld's point away from home... (1:124/7006.1)
  1011.  
  1012.  
  1013.  
  1014. ════════════════════════════════════════════════════════════════════════════════
  1015.  Area:    QuickBasic
  1016.   Msg:    #5897
  1017.  Date:    03-21-93 12:33 (Public)
  1018.  From:    JEFF FREEMAN
  1019.  To:      QUINN TYLER JACKSON
  1020.  Subject: ANSI0001.BAS 3/3
  1021. ────────────────────────────────────────────────────────────────────────────────
  1022. '>>> Start of page 3.
  1023.  
  1024. SUB sjfParse (Word$(), Txt$, Spt$, NumWords)
  1025.  
  1026.   'Spt$ = the line seperator
  1027.   'Word$() = the array in which to return the parsed line
  1028.   'NumWords = -1 with Error-trapping enabled.
  1029.  
  1030.   'ON LOCAL ERROR GOTO BADParse
  1031.   Text$ = Txt$  ' the line to parse
  1032.   WordNum = 0
  1033.  
  1034.   DO
  1035.     WordNum = WordNum + 1
  1036.     'REDIM PRESERVE Word$(WordNum)
  1037.     Start = INSTR(Text$, Spt$)
  1038.     IF Start THEN
  1039.       Word$(WordNum) = LEFT$(Text$, Start - 1)
  1040.       Text$ = MID$(Text$, Start + LEN(Spt$))
  1041.     ELSE
  1042.       Word$(WordNum) = Text$
  1043.       Text$ = ""
  1044.     END IF
  1045.   LOOP WHILE LEN(Text$)
  1046.  
  1047.   NumWords = WordNum
  1048.   EXIT SUB
  1049.  
  1050. BADParse:
  1051.   NumWords = -1
  1052.  
  1053. END SUB
  1054.  
  1055. FUNCTION Txt2Ansi (Text$, Ansi$)
  1056.  
  1057.   'With error trapping, the function returns -1
  1058.   ' for errors, 0 for no errors.  Assumes TRUE and
  1059.   ' FALSE are defined consts.
  1060.  
  1061.   'ON LOCAL ERROR GOTO BadText
  1062.  
  1063.   Ansi$ = ""
  1064.   Txt$ = Text$
  1065.  
  1066.   DO
  1067.     StrStart = INSTR(Txt$, "@")
  1068.     IF StrStart = 0 THEN StrStart = LEN(Txt$) + 1
  1069.     IF StrStart <> 1 THEN
  1070.       Ansi$ = Ansi$ + LEFT$(Txt$, StrStart - 1)
  1071.       Txt$ = MID$(Txt$, StrStart)
  1072.     END IF
  1073.     StrEnd = INSTR(2, Txt$, "@")
  1074.     IF StrEnd = 0 THEN StrEnd = LEN(Txt$)
  1075.  
  1076.     Cmnd$ = LEFT$(Txt$, StrEnd)
  1077.     Ansi$ = Ansi$ + fjfTOANSI$(Cmnd$)
  1078.     Txt$ = MID$(Txt$, StrEnd + 1)
  1079.   LOOP WHILE LEN(Txt$)
  1080.   Txt2Ansi = FALSE
  1081. EXIT FUNCTION
  1082.  
  1083. BadText:
  1084.   Ansi$ = Text$
  1085.   Txt2Ansi = TRUE
  1086.  
  1087. END FUNCTION
  1088.  
  1089.  
  1090. '________O_/________________________| SNIP |______________________\_O_______
  1091. '        O \                        | HERE |                      / O
  1092.  
  1093. ---
  1094.  * Origin: WarWorld's point away from home... (1:124/7006.1)
  1095.  
  1096.  
  1097.  
  1098. ════════════════════════════════════════════════════════════════════════════════
  1099.  Area:    QuickBasic
  1100.   Msg:    #6938
  1101.  Date:    03-21-93 10:10 (Public)
  1102.  From:    CHARLES GRAHAM
  1103.  To:      ALL
  1104.  Subject: The miracle of compound i
  1105. ────────────────────────────────────────────────────────────────────────────────
  1106. 'SAVINGS.BAS
  1107. CLS
  1108. PRINT "    The Miracle of Compound Interest"
  1109. PRINT
  1110. PRINT "If you started saving  $166.67 per month"
  1111. PRINT "($2,000 per year) when you were 21, this"
  1112. PRINT "is the  total  savings  you'd have  when"
  1113. PRINT "you were  65  assuming  various  average"
  1114. PRINT "rates of interest."
  1115. PRINT
  1116. PRINT "Annual"
  1117. PRINT "Percentage"
  1118. PRINT "Rate (APR)", , "     Savings"
  1119. PRINT "----------", , "------------"
  1120. FOR APR% = 2 TO 12
  1121.     monthlyrate = 1 + (APR% / 1200)
  1122.     savings = 0
  1123.     FOR months% = 1 TO 528
  1124.         savings = savings * monthlyrate
  1125.         savings = savings + 166.67
  1126.     NEXT months%
  1127.     PRINT USING "##"; APR%;
  1128.     PRINT , ,
  1129.     PRINT USING "########,.##"; savings
  1130. NEXT APR%
  1131. LOCATE 25, 1
  1132. PRINT "        . Press a key to quit .";
  1133. DO
  1134.     a$ = INKEY$
  1135. LOOP UNTIL LEN(a$)
  1136. CLS
  1137. END
  1138.  
  1139.  
  1140. --- QM v1.30
  1141.  * Origin: QwikCom * St Charles MO * 16.8K HST/V32b (1:100/602.0)
  1142.  
  1143.  
  1144.