home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR36 / DRGDRP.ZIP / 3DBOX.PRG < prev    next >
Text File  |  1993-11-05  |  14KB  |  490 lines
  1. ***************************************************************************
  2. *
  3. * Procedure file: 3DBOX.PRG
  4. *         System: 3DBox
  5. *        Version: 1.4
  6. *         Author: Bill Anderson
  7. *      Copyright: None (Public Domain)
  8. *
  9. ***************************************************************************
  10. *
  11. * 3DBOX - 3D Box Generator.
  12. *
  13. * Description:
  14. * This program is used to draw a 3-D box.
  15. *
  16. *                  * * *  PARAMETER MEMORY VARIABLES  * * *
  17. *
  18. *            m.boxrow   = holds the beginning row of the box.
  19. *            m.boxcol   = holds the beginning column of the box.
  20. *            m.boxhgt   = holds the height of the drawn box.
  21. *            m.boxwdth  = holds the width of the drawn box.
  22. *            m.boxpenw  = holds the pen width of the bevel.
  23. *            m.sunr     = holds the red color intensity of
  24. *                         the sun color.
  25. *            m.sung     = holds the green color intensity of
  26. *                         the sun color.
  27. *            m.sunb     = holds the blue color intensity of
  28. *                         the sun color.
  29. *            m.shader   = holds the red color intensity of
  30. *                         the shade color.
  31. *            m.shadeg   = holds the green color intensity of
  32. *                         the shade color.
  33. *            m.shadeb   = holds the blue color intensity of
  34. *                         the shade color.
  35. *            m.facer    = holds the red color intensity of
  36. *                         the face color.
  37. *            m.faceg    = holds the green color intensity of
  38. *                         the face color.
  39. *            m.faceb    = holds the blue color intensity of
  40. *                         the face color.
  41. *            m.outliner = holds the red color intensity of
  42. *                         the outline color.
  43. *            m.outlineg = holds the green color intensity of
  44. *                         the outline color.
  45. *            m.outlineb = holds the blue color intensity of
  46. *                         the outline color.
  47. *            m.pattern  = holds the pattern of the face of the
  48. *                         3-D box.
  49. *            m.pentype  = holds the pen type used for 
  50. *                         the outline box.
  51. *
  52. *                  * * *  DECLARED MEMORY VARIABLES  * * *
  53. *
  54. *            m.curpenw  = holds the passed pen width.
  55. *            m.tempr    = holds the red sun color intensity.
  56. *                         Used for in-laid effects.
  57. *            m.tempg    = holds the green sun color intensity.
  58. *                         Used for in-laid effects.
  59. *            m.tempb    = holds the blue sun color intensity.
  60. *                         Used for in-laid effects.
  61. *            m.out_on   = used as a logical variable in order to 
  62. *                         determine whether the outline box 
  63. *                         should be drawn.
  64. *            m.setdec   = holds the previous SET DECIMAL setting
  65. *            m.curfont  = holds the font type used to calculate
  66. *                         the pixel lengths.
  67. *            m.cursize  = holds the font size used to calculate
  68. *                         the pixel lengths.
  69. *            m.curstyle = holds the font style used to calculate
  70. *                         the pixel lengths.
  71. *            m.hclength = holds the horizontal pixel to 
  72. *                         character ratio.
  73. *            m.vclength = holds the vertical pixel to 
  74. *                         character ratio.
  75. *            m.currow   = holds the passed row.
  76. *            m.curcol   = holds the passed column.
  77. *            m.looppen  = holds the interim pen value for the boxes
  78. *                         and triangles.
  79. *            m.prevpen  = holds the previous pen value when
  80. *                         going through the drawing loop.
  81. *            m.counter  = a counter.
  82. *            mcounter   = another counter.
  83. *                         
  84. * 
  85. ************************************************************************
  86. * Example:
  87. *
  88. * DO 3DBOX.PRG WITH 6, 10, 10, 5, 4, 255, 255, 255, ;
  89. * 128, 128, 128, 192, 192, 192, 0, 0, 0, 1, -1
  90. *
  91. ************************************************************************
  92. *
  93.  
  94. PARAMETERS boxrow, boxcol, boxhgt, boxwdth, boxpenw, sunr, sung, sunb,;
  95. shader, shadeg, shadeb, facer, faceg, faceb, outliner, outlineg, outlineb,;
  96. pattern, pentype
  97.  
  98. PRIVATE curpenw, tempr, tempg, tempb, out_on, setdec, curfont, cursize,;
  99. curstyle, hclength, vclength, currow, curcol, looppen, prevpen, counter,;
  100. mcounter, row, col
  101.  
  102. ** Windows/Mac platform test
  103. IF TYPE([_WINDOWS])# [L] OR (NOT _WINDOWS AND NOT _MAC)
  104.  
  105.   RETURN .f.
  106.  
  107. ENDIF TYPE([_WINDOWS])# [L] OR (NOT _WINDOWS AND NOT _MAC)
  108. ** End windows platform test
  109.  
  110. ** Negative row test
  111. IF m.boxrow < 0
  112.  
  113.   WAIT WINDOW [Negative row provided for this box.] NOWAIT
  114.   RETURN .f.
  115.  
  116. ENDIF m.boxrow < 0
  117. ** End negative row test
  118.  
  119. ** Negative column test
  120. IF m.boxcol < 0
  121.  
  122.   WAIT WINDOW [Negative column provided for this box.] NOWAIT
  123.   RETURN .f.
  124.  
  125. ENDIF m.boxcol < 0
  126. ** End negative column test
  127.  
  128. ** Bad height test
  129. IF m.boxhgt <= 0
  130.  
  131.   WAIT WINDOW [Invalid height provided for this box.] NOWAIT
  132.   RETURN .f.
  133.  
  134. ENDIF m.boxhgt <= 0
  135. ** End bad height test
  136.  
  137. ** Bad width test
  138. IF m.boxwdth <= 0
  139.  
  140.   WAIT WINDOW [Invalid width provided for this box.] NOWAIT
  141.   RETURN .f.
  142.  
  143. ENDIF m.boxwdth <= 0
  144. ** End bad width test
  145.  
  146. ** Empty button face pattern test
  147. IF TYPE([m.pattern]) # [N] OR EMPTY(m.pattern)
  148.  
  149.   m.pattern = 1
  150.  
  151. ENDIF TYPE([m.pattern]) # [N] OR EMPTY(m.pattern)
  152. ** End empty button face pattern test
  153.  
  154. ** Empty outline pen type test
  155. IF TYPE([m.pentype]) # [N] OR EMPTY(m.pentype)
  156.  
  157.   m.pentype = -1
  158.  
  159. ENDIF EMPTY([m.pentype])
  160. ** End empty outline pen type test
  161.  
  162. ** Width too long test
  163. IF m.boxcol + m.boxwdth >= WCOLS()
  164.  
  165.   WAIT WINDOW [Box width too long for window.] NOWAIT
  166.   RETURN .f.
  167.  
  168. ENDIF m.boxcol + m.boxwdth >= WCOLS()
  169. ** End width too long test
  170.  
  171. ** Height too big test
  172. IF m.boxrow + m.boxhgt >= WROWS()
  173.  
  174.   WAIT WINDOW [Box height too big for window.] NOWAIT
  175.   RETURN .f.
  176.  
  177. ENDIF m.boxrow + m.boxhgt >= WROWS()
  178. ** End height too big test
  179.  
  180. m.curpenw = m.boxpenw
  181.  
  182. ** Pen width type test
  183. IF TYPE([m.curpenw]) # [N]
  184.  
  185.   m.curpenw = 0
  186.  
  187. ENDIF TYPE([m.curpenw]) # [N]
  188. ** End pen width type test
  189.  
  190. ** Pen width value test
  191. IF BETWEEN(m.curpenw, -2, 2)
  192.  
  193.   m.curpenw = ROUND(m.curpenw, 0)
  194.  
  195. ENDIF BETWEEN(m.curpenw, -2, 2)
  196. ** End pen width value test
  197.  
  198. ** Memory variable type test
  199. IF TYPE([m.sunr]) # [N]
  200.  
  201.   m.sunr = 255
  202.  
  203. ENDIF TYPE([m.sunr]) # [N]
  204. ** End memory variable type test
  205.  
  206. ** Memory variable type test
  207. IF TYPE([m.sung]) # [N]
  208.  
  209.   m.sung = 255
  210.  
  211. ENDIF TYPE([m.sung]) # [N]
  212. ** End memory variable type test
  213.  
  214. ** Memory variable type test
  215. IF TYPE([m.sunb]) # [N]
  216.  
  217.   m.sunb = 255
  218.  
  219. ENDIF TYPE([m.sunb]) # [N]
  220. ** End memory variable type test
  221.  
  222. ** Memory variable type test
  223. IF TYPE([m.shader]) # [N]
  224.  
  225.   m.shader = 128
  226.  
  227. ENDIF TYPE([m.shader]) # [N]
  228. ** End memory variable type test
  229.  
  230. ** Memory variable type test
  231. IF TYPE([m.shadeg]) # [N]
  232.  
  233.   m.shadeg = 128
  234.  
  235. ENDIF TYPE([m.shadeg]) # [N]
  236. ** End memory variable type test
  237.  
  238. ** Memory variable type test
  239. IF TYPE([m.shadeb]) # [N]
  240.  
  241.   m.shadeb = 128
  242.  
  243. ENDIF TYPE([m.shadeb]) # [N]
  244. ** End memory variable type test
  245.  
  246. ** In-laid box test
  247. IF m.curpenw < 0
  248.  
  249.   m.tempr = m.sunr
  250.   m.tempg = m.sung
  251.   m.tempb = m.sunb
  252.   m.sunr = m.shader
  253.   m.sung = m.shadeg
  254.   m.sunb = m.shadeb
  255.   m.shader = m.tempr
  256.   m.shadeg = m.tempg
  257.   m.shadeb = m.tempb
  258.   m.curpenw = -m.curpenw
  259.   
  260. ENDIF m.curpenw < 0
  261. ** End in-laid box test
  262.  
  263. ** Memory variable type test
  264. IF TYPE([m.facer]) # [N]
  265.  
  266.   m.facer = 192
  267.  
  268. ENDIF TYPE([m.facer]) # [N]
  269. ** End memory variable type test
  270.  
  271. ** Memory variable type test
  272. IF TYPE([m.faceg]) # [N]
  273.  
  274.   m.faceg = 192
  275.  
  276. ENDIF TYPE([m.faceg]) # [N]
  277. ** End memory variable type test
  278.  
  279. ** Memory variable type test
  280. IF TYPE([m.faceb]) # [N]
  281.  
  282.   m.faceb = 192
  283.  
  284. ENDIF TYPE([m.faceb]) # [N]
  285. ** End memory variable type test
  286.  
  287. ** Outline color parameter passing test
  288. IF TYPE([m.outliner]) # [N] AND ;
  289. TYPE([m.outlineg]) # [N] AND TYPE([m.outlineb]) # [N]
  290.  
  291.   m.out_on = .f.
  292.   STORE 192 TO m.outliner, m.outlineg, m.outlineb
  293.   
  294. ELSE 
  295.  
  296.   m.out_on = .t.  
  297.  
  298.   ** Memory variable type test
  299.   IF TYPE([m.outliner]) # [N]
  300.  
  301.     m.outliner = 192
  302.  
  303.   ENDIF TYPE([m.outliner]) # [N]
  304.   ** End memory variable type test
  305.  
  306.   ** Memory variable type test
  307.   IF TYPE([m.outlineg]) # [N]
  308.  
  309.     m.outlineg = 192
  310.  
  311.   ENDIF TYPE([m.outlineg]) # [N]
  312.   ** End memory variable type test
  313.  
  314.   ** Memory variable type test
  315.   IF TYPE([m.outlineb]) # [N]
  316.  
  317.     m.outlineb = 192
  318.  
  319.   ENDIF TYPE([m.outlineb]) # [N]
  320.   ** End memory variable type test
  321.  
  322. ENDIF TYPE([m.outliner]) # [N] AND ;
  323. TYPE([m.outlineg]) # [N] AND TYPE([m.outlineb]) # [N]
  324. ** End outline color parameter passing test
  325.  
  326. m.setdec = SET([DECIMALS])
  327. SET DECIMALS TO 15
  328. m.woutput = WOUTPUT()
  329. m.curfont = WFONT(1, m.woutput)       && holds the current font
  330. m.cursize = WFONT(2, m.woutput)       && holds the current size
  331. m.curstyle = WFONT(3, m.woutput)      && holds the current style
  332. m.hclength = FONTMETRIC(6, m.curfont, m.cursize, m.curstyle)
  333. m.vclength = FONTMETRIC(1, m.curfont, m.cursize, m.curstyle) + ;
  334. FONTMETRIC(5, m.curfont, m.cursize, m.curstyle)
  335.  
  336. ** Pen thickness test
  337. IF m.hclength * m.boxwdth <= m.curpenw * 2
  338.  
  339.   WAIT WINDOW [Pen width along horizontal axis too thick.] NOWAIT
  340.   SET DECIMALS TO &m.setdec
  341.   RETURN .f.
  342.  
  343. ENDIF m.hclength * m.boxwdth <= m.curpenw * 2
  344. ** End pen thickness test
  345.  
  346. ** Pen thickness test
  347. IF m.vclength * m.boxhgt <= m.curpenw * 2
  348.  
  349.   WAIT WINDOW [Pen width along vertical axis too thick.] NOWAIT
  350.   SET DECIMALS TO &m.setdec
  351.   RETURN .f.
  352.  
  353. ENDIF m.hclength * m.boxwdth <= m.curpenw * 2
  354. ** End pen thickness test
  355.  
  356. m.currow = m.boxrow
  357. m.curcol = m.boxcol
  358. m.looppen = m.curpenw
  359.  
  360. ** Box drawing loop
  361. FOR m.counter = 1 TO CEILING(m.curpenw / 6)
  362.  
  363.    m.looppen = IIF(m.looppen < 7, m.looppen, 6)
  364.    
  365.    ** First time through test
  366.    IF m.counter = 1
  367.    
  368.      m.prevpen = m.looppen
  369.      
  370.    ENDIF m.counter = 1
  371.    ** End first time through test
  372.    
  373.    DO BOXDRAW
  374.  
  375.    ** Row adjustment test
  376.    IF m.counter < CEILING(m.curpenw / 6)
  377.    
  378.      m.boxrow = m.boxrow + (m.looppen / m.vclength)
  379.      m.boxcol = m.boxcol + (m.looppen / m.hclength)
  380.      m.prevpen = m.looppen
  381.      m.looppen = m.curpenw - (6 * m.counter)
  382.      
  383.    ENDIF m.counter < CEILING(m.curpenw / 6)
  384.    ** End row adjustment test
  385.  
  386. ENDFOR m.counter = 1 TO CEILING(m.curpenw / 6)
  387. ** End box drawing loop
  388.  
  389. ** Button face
  390. @ m.currow + (m.curpenw / m.vclength), ;
  391. m.curcol + (m.curpenw / m.hclength) TO ;
  392. (m.currow + m.boxhgt) - (m.curpenw / m.vclength), ;
  393. (m.curcol + m.boxwdth) - (m.curpenw / m.hclength) ;  
  394. PATTERN m.pattern COLOR ;
  395. RGB(m.facer, m.faceg, m.faceb, m.facer, m.faceg, m.faceb)
  396.  
  397. ** Outline box drawing test
  398. IF m.out_on
  399.  
  400.   @ m.currow, m.curcol TO m.currow + m.boxhgt, m.curcol + m.boxwdth ;
  401.   PATTERN 0 PEN 0, m.pentype STYLE [1] ;
  402.   COLOR RGB(m.outliner, m.outlineg, m.outlineb, ;
  403.   m.outliner, m.outlineg, m.outlineb)
  404.  
  405. ENDIF m.out_on
  406. ** End outline box drawing test
  407.  
  408. SET DECIMALS TO &m.setdec
  409.  
  410. RETURN 
  411.  
  412. *****************
  413. PROCEDURE BOXDRAW
  414. *****************
  415.  
  416. ** Top line
  417. @ m.boxrow, m.boxcol TO m.boxrow, m.boxcol + ;
  418. (m.boxwdth - (((((2 * m.counter) - 1) * ;
  419. m.prevpen) - (m.prevpen - m.looppen)) / m.hclength)) ;
  420. PATTERN 0 PEN m.looppen STYLE [0] ;
  421. COLOR RGB(m.sunr, m.sung, m.sunb, m.sunr, m.sung, m.sunb)
  422.  
  423. ** Upper right triangles
  424. DO TRIANGLES WITH m.boxrow, m.boxcol + ;
  425. (m.boxwdth - (((((2 * m.counter) - 1) * ;
  426. m.prevpen) - (m.prevpen - m.looppen)) / m.hclength))
  427.  
  428. ** Left line
  429. @ m.boxrow + (m.looppen / m.vclength), m.boxcol TO ;
  430. m.boxrow + (m.boxhgt - (((((2 * m.counter) - 1) * ;
  431. m.prevpen) - (m.prevpen - m.looppen)) / m.vclength)), m.boxcol ;
  432. PATTERN 0 PEN m.looppen STYLE [0] ;
  433. COLOR RGB(m.sunr, m.sung, m.sunb, m.sunr, m.sung, m.sunb) 
  434.  
  435. ** Right line
  436. @ m.boxrow + (m.looppen / m.vclength), ;
  437. m.boxcol + (m.boxwdth - (((((2 * m.counter) - 1) * ;
  438. m.prevpen) - (m.prevpen - m.looppen)) / m.hclength)) TO ;
  439. m.boxrow + m.boxhgt - ;
  440. ((((m.counter - 1) * 2) * m.prevpen) / m.vclength), ;
  441. m.boxcol + (m.boxwdth - (((((2 * m.counter) - 1) * ;
  442. m.prevpen) - (m.prevpen - m.looppen)) / m.hclength)) ;
  443. PATTERN 0 PEN m.looppen STYLE [0] ;
  444. COLOR RGB(m.shader, m.shadeg, m.shadeb, m.shader, m.shadeg, m.shadeb)
  445.  
  446. ** Lower left triangles
  447. DO TRIANGLES WITH m.boxrow + ;
  448. (m.boxhgt - (((((2 * m.counter) - 1) * ;
  449. m.prevpen) - (m.prevpen - m.looppen)) / m.vclength)), m.boxcol
  450.  
  451. ** Bottom line
  452. @ m.boxrow + (m.boxhgt - (((((2 * m.counter) - 1) * ;
  453. m.prevpen) - (m.prevpen - m.looppen)) / m.vclength)), ;
  454. m.boxcol + (m.looppen / m.hclength) TO ;
  455. m.boxrow + (m.boxhgt - (((((2 * m.counter) - 1) * ;
  456. m.prevpen) - (m.prevpen - m.looppen)) / m.vclength)), ;
  457. m.boxcol + (m.boxwdth - (((((2 * m.counter) - 1) * ;
  458. m.prevpen) - (m.prevpen - m.looppen)) / m.hclength)) ;
  459. PATTERN 0 PEN m.looppen STYLE [0] ;
  460. COLOR RGB(m.shader, m.shadeg, m.shadeb, m.shader, m.shadeg, m.shadeb)
  461.  
  462. RETURN
  463.  
  464. *******************
  465. PROCEDURE TRIANGLES
  466. *******************
  467.  
  468. PARAMETERS m.row, m.col
  469.  
  470. ** Line drawing loop
  471. FOR mcounter = 1 TO m.looppen
  472.  
  473.   @ m.row + ((mcounter - 1) / m.vclength), m.col TO ;
  474.   m.row + ((mcounter - 1) / m.vclength), ;
  475.   m.col + ((m.looppen - mcounter) / m.hclength) ;
  476.   PATTERN 0 PEN 1 STYLE [0] ;
  477.   COLOR RGB(m.sunr, m.sung, m.sunb)
  478.   @ m.row + ((mcounter - 1) / m.vclength), ;
  479.   m.col + ((m.looppen - mcounter) / m.hclength) TO ;
  480.   m.row + ((mcounter - 1) / m.vclength), ;
  481.   m.col + (m.looppen / m.hclength) ;
  482.   PATTERN 0 PEN 1 STYLE [0] ;
  483.   COLOR RGB(m.shader, m.shadeg, m.shadeb)
  484.   
  485. ENDFOR mcounter = 1 TO m.looppen
  486. ** End line drawing loop
  487.  
  488. RETURN
  489.  
  490. * EOF: 3DBOX.PRG