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