8-Bit Software Online Conversion

3D Demo - Listing

10REM >3DMonoDemo 20REM 30REM by Steven Flintham 40REM 50REM A demonstration of the very nic e "greyscale" 3D effect which can be 60REM produced using a monochrome mon itor (or one of those devices that 70REM lets you convert any "digital" colour into an "analogue" one - such 80REM as the SPX palette extension bo ard) 90REM 100REM Sunday 31st May 1992 110REM Sunday 5th July 1992 120REM Saturday 28th August 1992 130REM Saturday 24th October 1992 140: 150REM Note that this will just select mode 1 without an error if no shadow 160REM mode is available 170: 180MODE 129 190VDU 23;8202;0;0;0; 200PROCdisable 210PROCinitialise 220PROCpage1 230PROCpage2 240PROCpage3 250MODE 7 260PROCenable 270END 280: 290DEF PROCtitle 300COLOUR 129:CLS 310PROCdraw`3d`box(160,940,1120,1008,T RUE,FALSE) 320PROCplace`text`centred`in`3d`box(16 0,940,1120,1008,TRUE,"Monochrome 3D demo nstration",3) 330ENDPROC 340: 350DEF PROCpage1 360PROCtitle 370PROCdraw`outline`box(16,732,1260,89 2,TRUE,"Introduction") 380VDU 5 390GCOL 0,3 400MOVE 32,844 410PRINT "This program is intended to show the" 420MOVE 32,812 430PRINT "monochrome 3D effect which c an be" 440MOVE 32,780 450PRINT "produced on non-colour displ ays." 460PROCdraw`outline`box(16,268,1260,68 4,TRUE,"Outline boxes") 470VDU 5 480GCOL 0,3 490MOVE 32,636 500PRINT "Outline boxes are used exten sively" 510MOVE 32,604 520PRINT "on this screen. They can be used to" 530MOVE 32,572 540PRINT "surround areas of text or re lated" 550MOVE 32,540 560PRINT "information. Most have title s, as this" 570MOVE 32,508 580PRINT "one does, but it is not nece ssary to" 590MOVE 32,476 600PRINT "have a title." 610MOVE 32,412 620PRINT "For example, a wordprocessor using" 630MOVE 32,380 640PRINT "this style of screen layout might have" 650MOVE 32,348 660PRINT "the text in one outline box and the" 670MOVE 32,316 680PRINT "status information in anothe r." 690VDU 4 700PROCspace 710ENDPROC 720: 730DEF PROCpage2 740PROCtitle 750PROCdraw`outline`box(16,540,1260,89 2,TRUE,"3D boxes") 760VDU 5 770GCOL 0,3 780MOVE 32,844 790PRINT "3D boxes are 'slabs' which a ppear" 800MOVE 32,812 810PRINT "raised or recessed. They are used" 820MOVE 32,780 830PRINT "for the title at the top of this" 840MOVE 32,748 850PRINT "screen, and as the titles of outline" 860MOVE 32,716 870PRINT "boxes." 880MOVE 32,652 890PRINT "They can also be used, as in the" 900MOVE 32,620 910PRINT "example below, to highlight data in an" 920MOVE 32,588 930PRINT "outline box." 940PROCdraw`outline`box(16,284,1260,49 2,TRUE,"Status") 950VDU 5 960GCOL 0,3 970MOVE 32,428 980PRINT "Word count" 990PROCdraw`3d`box(420,384,160,56,FALS E,TRUE) 1000PROCplace`text`centred`in`3d`box(42 0,384,160,56,FALSE,"310",3) 1010VDU 5 1020GCOL 0,3 1030MOVE 32,348 1040PRINT "RAM free" 1050PROCdraw`3d`box(420,304,160,56,FALS E,TRUE) 1060PROCplace`text`centred`in`3d`box(42 0,304,160,56,FALSE,"8K",3) 1070VDU 5 1080GCOL 0,3 1090MOVE 640,348 1100PRINT "RAM used" 1110PROCdraw`3d`box(1028,304,160,56,FAL SE,TRUE) 1120PROCplace`text`centred`in`3d`box(10 28,304,160,56,FALSE,"3K",3) 1130VDU 4 1140PROCspace 1150ENDPROC 1160: 1170DEF PROCpage3 1180PROCtitle 1190PROCdraw`outline`box(16,572,1260,89 2,TRUE,"3D boxes") 1200VDU 5 1210GCOL 0,3 1220MOVE 32,844 1230PRINT "An alternative form of 3D bo x is" 1240MOVE 32,812 1250PRINT "available, which has a white centre." 1260MOVE 32,780 1270PRINT "You could use the two styles to" 1280MOVE 32,748 1290PRINT "signify something, or just u se" 1300MOVE 32,716 1310PRINT "whichever you prefer." 1320MOVE 32,652 1330PRINT "The previous example is repr oduced" 1340MOVE 32,620 1350PRINT "below in the alternative sty le." 1360PROCdraw`outline`box(16,316,1260,52 4,TRUE,"Status") 1370VDU 5 1380GCOL 0,3 1390MOVE 32,460 1400PRINT "Word count" 1410PROCdraw`3d`box`with`centre(420,416 ,160,56,FALSE,TRUE) 1420PROCplace`text`centred`in`3d`box(42 0,416,160,56,FALSE,"310",3) 1430VDU 5 1440GCOL 0,3 1450MOVE 32,380 1460PRINT "RAM free" 1470PROCdraw`3d`box`with`centre(420,336 ,160,56,FALSE,TRUE) 1480PROCplace`text`centred`in`3d`box(42 0,336,160,56,FALSE,"8K",3) 1490VDU 5 1500GCOL 0,3 1510MOVE 640,380 1520PRINT "RAM used" 1530PROCdraw`3d`box`with`centre(1028,33 6,160,56,FALSE,TRUE) 1540PROCplace`text`centred`in`3d`box(10 28,336,160,56,FALSE,"3K",3) 1550VDU 4 1560PROCspace 1570ENDPROC 1580: 1590DEF PROCspace 1600PROCdraw`outline`box(16,16,1260,96, TRUE,"") 1610VDU 5 1620GCOL 0,3 1630MOVE 224,68 1640PRINT "Press SPACE to continue..." 1650VDU 4 1660*FX21 1670REPEAT UNTIL GET=32 1680ENDPROC 1690: 1700DEF PROCinitialise 1710gxr%=FNgxr`present 1720: 1730REM The following lines are my sugg ested RGB values for the colours if 1740REM you are using a colour card suc h as the Chameleon or SPX boards. As 1750REM these is no standard way of con trolling these, I have used the BASIC 1760REM V format which you can convert as required. The format is: 1770REM 1780REM COLOUR <colour to define>,<red component>,<green component>, 1790REM <blue component> - all the comp onents are on a scale of 0-255 1800: 1810REM COLOUR 0,255,255,255 1820REM COLOUR 1,170,170,170 1830REM COLOUR 2,85,85,85 1840REM COLOUR 3,0,0,0 1850: 1860REM The following lines define the colours so that they give a grey 1870REM scale on monochrome displays 1880: 1890VDU 19,0,7,0,0,0 1900VDU 19,1,6,0,0,0 1910VDU 19,2,1,0,0,0 1920VDU 19,3,0,0,0,0 1930: 1940COLOUR 129:CLS 1950ENDPROC 1960: 1970DEF PROCdraw`outline`box(bx%,by%,tx %,ty%,absolute%,title$) 1980REM Draw an outline box, with a sla bbed 3D box as a heading if title$ 1990REM is not null 2000LOCAL len% 2010IF NOT absolute% THEN tx%=bx%+tx%:t y%=by%+ty% 2020GCOL 0,2 2030PROCrectangle(bx%,by%,tx%,ty%) 2040GCOL 0,0 2050MOVE bx%,by% 2060DRAW bx%,ty% 2070DRAW tx%-4,ty% 2080DRAW tx%-4,by%+4 2090DRAW bx%,by%+4 2100GCOL 0,1 2110PROCrectangle(bx%+8,by%+8,tx%-8,ty% -8) 2120IF title$="" THEN ENDPROC 2130len%=LEN(title$)*32 2140PROCdraw`3d`box(bx%+32,ty%-24,bx%+6 4+len%,ty%+24,TRUE,FALSE) 2150GCOL 0,2 2160PLOT 69,bx%+32,ty%-4 2170GCOL 0,0 2180PLOT 69,bx%+64+len%,ty% 2190VDU 5 2200GCOL 0,3 2210MOVE bx%+48,ty%+12 2220PRINT title$ 2230VDU 4 2240ENDPROC 2250: 2260DEF PROCdraw`3d`box(bx%,by%,tx%,ty% ,absolute%,in%) 2270REM Draw a slabbed 3D box 2280LOCAL col1%,col2% 2290IF NOT absolute% THEN tx%=bx%+tx%:t y%=by%+ty% 2300IF in% THEN col1%=2:col2%=0 ELSE co l1%=0:col2%=2 2310GCOL 0,1 2320PROCrectangle(bx%,by%,tx%,ty%) 2330GCOL 0,col1% 2340MOVE bx%,by% 2350DRAW bx%,ty% 2360DRAW tx%,ty% 2370GCOL 0,col2% 2380MOVE bx%+4,by% 2390DRAW tx%,by% 2400DRAW tx%,ty%-4 2410ENDPROC 2420: 2430DEF PROCdraw`3d`box`with`centre(bx% ,by%,tx%,ty%,absolute%,in%) 2440REM Draw a slabbed 3D box with a wh ite box in the centre 2450IF NOT absolute% THEN tx%=bx%+tx%:t y%=by%+ty% 2460PROCdraw`3d`box(bx%,by%,tx%,ty%,TRU E,in%) 2470GCOL 0,0 2480PROCrectangle(bx%+8,by%+8,tx%-8,ty% -8) 2490GCOL 0,3 2500PROCoutline`rect(bx%+8,by%+8,tx%-8, ty%-8) 2510ENDPROC 2520: 2530DEF PROCplace`text`centred`in`3d`bo x(bx%,by%,tx%,ty%,absolute%,text$,col%) 2540REM Place text centred in an existi ng 3D box 2550IF NOT absolute% THEN tx%=bx%+tx%:t y%=by%+ty% 2560VDU 5 2570GCOL 0,col% 2580MOVE bx%+((tx%-bx%)/2)-LEN(text$)*1 6,by%+((ty%-by%)/2)+12 2590PRINT text$ 2600VDU 4 2610ENDPROC 2620: 2630DEF FNgxr`present 2640REM This is a useful function which should be called just after a mode 2650REM change (it needs a blank screen ) which returns TRUE if a GXR is 2660REM present (or it's running on a M aster or above - which is the same 2670REM thing as far as GXR facilities are concerned). The screen mode should 2680REM be reselected afterwards as it corrupts the display slightly. 2690GCOL 0,7 2700REM Plot a circle using GXR command s (nothing will appear if it is not 2710REM present) 2720MOVE 640,512 2730PLOT &99,32,0 2740REM Return TRUE if the circle has b een plotted - i.e., if there is a 2750REM non-black pixel at the centre o f the screen 2760=(POINT(640,512)>0) 2770: 2780DEF PROCrectangle(bx%,by%,tx%,ty%) 2790REM Draw a solid rectangle in the c urrent colour 2800IF gxr% THEN PROCrect`gxr(bx%,by%,t x%,ty%) ELSE PROCrect`nogxr(bx%,by%,tx%, ty%) 2810ENDPROC 2820: 2830DEF PROCrect`gxr(bx%,by%,tx%,ty%) 2840REM Draw a solid rectangle in the c urrent colour using the GXR 2850MOVE bx%,by% 2860PLOT &65,tx%,ty% 2870ENDPROC 2880: 2890DEF PROCrect`nongxr(bx%,by%,tx%,ty% ) 2900REM Draw a solid rectangle in the c urrent colour using triangles 2910MOVE bx%,by% 2920MOVE tx%,by% 2930PLOT 85,tx%,ty% 2940MOVE bx%,ty% 2950PLOT 85,bx%,by% 2960ENDPROC 2970: 2980DEF PROCoutline`rect(bx%,by%,tx%,ty %) 2990REM Draw an outline rectangle in th e current colour 3000MOVE bx%,by% 3010DRAW tx%,by% 3020DRAW tx%,ty% 3030DRAW bx%,ty% 3040DRAW bx%,by% 3050ENDPROC 3060: 3070DEF PROCdisable 3080*FX229,1 3090*FX4,2 3100ENDPROC 3110: 3120DEF PROCenable 3130*FX229 3140*FX4 3150ENDPROC