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