This module is part of the original MMBasic library. It is reproduced here with kind permission of Hugh Buckle and Geoff Graham. Be aware it may reference functionality which has changed or is deprecated in the latest versions of MMBasic.¶
Note: Any required file(s) are available in the attachments tab (top right).
Demonstration programs for the Colour Maximite:
CMM4_TST.BASA test program that demonstrates various graphics on the Colour Maximite running in MODE 4. These include coloured lines, boxes, circles and moving images on the screen using the BLIT command.
'Graphic test for ColourMM V4.0 Final Release.
'Muller Fabrice
'2012
'This program just show all graphics functions.
'That is :
'Pixels
'Lines
'Box
'Filled Box
'Circles
'Filled Circle
'and the new Blitter !!
'declare some arrays
Dim px1(10)
Dim px2(10)
Dim py1(10)
Dim py2(10)
Dim ox1(10)
Dim ox2(10)
Dim oy1(10)
Dim oy2(10)
Dim dx1(10)
Dim dx2(10)
Dim dy1(10)
Dim dy2(10)
'Game Graphic Mode 240 x 216 in 8 colors
Mode 4
'clear the screen
Cls
'Generic pixels graphics
For a = 1 To 2000
x = Int(Rnd * MM.HRes)
y = Int(Rnd * MM.VRes)
Pixel(x,y) = Int(Rnd * 8)
Next a
Print @(0,0) "2000 Pixels"
Do While Inkey$ = "" : Loop
Randomize Timer
'clear the screen
'Cls
box_erase
'Lines
For a = 1 To 2000
x1 = Int(Rnd * MM.HRes)
y1 = Int(Rnd * MM.VRes)
x2 = Int(Rnd * MM.HRes)
y2 = Int(Rnd * MM.VRes)
Line (x1,y1)-(x2,y2),Int(Rnd * 8)
Next a
Print @(0,0) "2000 Lines"
Do While Inkey$ = "" : Loop
'clear the screen
'Cls
box_erase
'Box's
For a = 1 To 2000
x1 = Int(Rnd * MM.HRes)
y1 = Int(Rnd * MM.VRes)
x2 = Int(Rnd * MM.HRes)
y2 = Int(Rnd * MM.VRes)
Line (x1,y1)-(x2,y2),Int(Rnd * 8),b
Next a
Print @(0,0) "2000 Box"
Do While Inkey$ = "" : Loop
'clear the screen
'Cls
box_erase
'Filled Box's
For a = 1 To 200
x1 = Int(Rnd * MM.HRes)
y1 = Int(Rnd * MM.VRes)
x2 = Int(Rnd * MM.HRes)
y2 = Int(Rnd * MM.VRes)
Line (x1,y1)-(x2,y2),Int(Rnd * 8),bf
Next a
Print @(0,0) "200 Filled Box"
Do While Inkey$ = "" : Loop
'clear the screen
'Cls
box_erase
'Circles
For a = 1 To 2000
x1 = Int(Rnd * MM.HRes)
y1 = Int(Rnd * MM.VRes)
r = Int(Rnd * (MM.HRes/4))
Circle (x1,y1),r,Int(Rnd * 8)
Next a
Print @(0,0) "2000 Circles"
Do While Inkey$ = "" : Loop
'clear the screen
'Cls
box_erase
'Filled Circles
For a = 1 To 200
x1 = Int(Rnd * MM.HRes)
y1 = Int(Rnd * MM.VRes)
r = Int(Rnd * (MM.HRes/4))
Circle (x1,y1),r,Int(Rnd * 8),f
Next a
Print @(0,0) "200 Filled Circles"
Do While Inkey$ = "" : Loop
'clear the screen
'Cls
box_erase
'Line Saver
For a = 1 To 7
ox1(a) = 0
oy1(a) = 0
ox2(a) = 0
oy2(a) = 0
px1(a) = Int(Rnd * MM.HRes)
py1(a) = Int(Rnd * MM.VRes)
px2(a) = Int(Rnd * MM.HRes)
py2(a) = Int(Rnd * MM.VRes)
dx1(a) = (Rnd * 5) + 3
dy1(a) = (Rnd * 5) + 3
dx2(a) = (Rnd * 5) + 3
dy2(a) = (Rnd * 5) + 3
Next a
Do While Inkey$ = ""
For a = 1 To 7
px1(a) = px1(a) + dx1(a)
py1(a) = py1(a) + dy1(a)
px2(a) = px2(a) + dx2(a)
py2(a) = py2(a) + dy2(a)
If px1(a) > MM.HRes - dx1(a) Then dx1(a) = -((Rnd * 5) + 3)
If py1(a) > MM.VRes - dy1(a) Then dy1(a) = -((Rnd * 5) + 3)
If px1(a) < Abs(dx1(a)) Then dx1(a) = (Rnd * 5) + 3
If py1(a) < Abs(dy1(a)) Then dy1(a) = (Rnd * 5) + 3
If px2(a) > MM.HRes - dx2(a) Then dx2(a) = -((Rnd * 5) + 3)
If py2(a) > MM.VRes - dy2(a) Then dy2(a) = -((Rnd * 5) + 3)
If px2(a) < Abs(dx2(a)) Then dx2(a) = (Rnd * 5) + 3
If py2(a) < Abs(dy2(a)) Then dy2(a) = (Rnd * 5) + 3
Line (ox1(a),oy1(a))-(ox2(a),oy2(a)),0
Line (px1(a),py1(a))-(px2(a),py2(a)),a
ox1(a) = px1(a)
oy1(a) = py1(a)
ox2(a) = px2(a)
oy2(a) = py2(a)
Next a
Loop
'clear the screen
'Cls
box_erase
'Blitter
For a = 0 To MM.HRes - 16 Step 16
For b = 0 To MM.VRes - 16 Step 16
Line(a,b)-(a+15,b+15),Int(Rnd * 7) + 1,bf
Line(a,b)-(a+15,b+15),0,b
Next b
Next a
For a = 0 To MM.VRes - 16 Step 32
For b = 0 To MM.HRes + 16
BLIT 0,a,1,a,MM.HRes,16
BLIT 0,a + 16,-1,a + 16,MM.HRes,16
Next b
Next a
For a = 0 To MM.HRes - 16 Step 16
For b = 0 To MM.VRes - 16 Step 16
Line(a,b)-(a+15,b+15),Int(Rnd * 7) + 1,bf
Line(a,b)-(a+15,b+15),0,b
Next b
Next a
For a = 0 To MM.HRes - 16 Step 32
For b = 0 To MM.VRes + 16
BLIT a,0,a,1,16,MM.VRes
BLIT a + 16,0,a + 16,-1,16,MM.VRes
Next b
Next a
For a = 0 To MM.HRes - 16 Step 16
For b = 0 To MM.VRes - 16 Step 16
Line(a,b)-(a+15,b+15),Int(Rnd * 7) + 1,bf
Line(a,b)-(a+15,b+15),0,b
Next b
Next a
For a = 0 To MM.HRes + 16
BLIT 0,0,1,0,MM.HRes,16
BLIT 0,16,-1,16,MM.HRes,16
BLIT 0,32,1,32,MM.HRes,16
BLIT 0,48,-1,48,MM.HRes,16
BLIT 0,64,1,64,MM.HRes,16
BLIT 0,80,-1,80,MM.HRes,16
BLIT 0,96,1,96,MM.HRes,16
8 BLIT 0,112,-1,112,MM.HRes,16
BLIT 0,128,1,128,MM.HRes,16
BLIT 0,144,-1,144,MM.HRes,16
BLIT 0,160,1,160,MM.HRes,16
BLIT 0,176,-1,176,MM.HRes,16
BLIT 0,192,1,192,MM.HRes,16
BLIT 0,208,-1,208,MM.HRes,16
BLIT 0,224,1,224,MM.HRes,16
Next a
For a = 0 To MM.HRes - 16 Step 16
For b = 0 To MM.VRes - 16 Step 16
Line(a,b)-(a+15,b+15),Int(Rnd * 7) + 1,bf
Line(a,b)-(a+15,b+15),0,b
Next b
Next a
For a = 0 To MM.VRes + 16
BLIT 0,0,0,1,16,MM.VRes
BLIT 16,0,16,-1,16,MM.VRes
BLIT 32,0,32,1,16,MM.VRes
BLIT 48,0,48,-1,16,MM.VRes
BLIT 64,0,64,1,16,MM.VRes
BLIT 80,0,80,-1,16,MM.VRes
BLIT 96,0,96,1,16,MM.VRes
BLIT 112,0,112,-1,16,MM.VRes
BLIT 128,0,128,1,16,MM.VRes
BLIT 144,0,144,-1,16,MM.VRes
BLIT 160,0,160,1,16,MM.VRes
BLIT 176,0,176,-1,16,MM.VRes
BLIT 192,0,192,1,16,MM.VRes
BLIT 208,0,208,-1,16,MM.VRes
BLIT 224,0,224,1,16,MM.VRes
BLIT 240,0,240,-1,16,MM.VRes
Next a
Print @(50,90) "End of Graphics test ..."
Do While Inkey$ = "" : Loop
box_erase
End
Sub box_erase
'erase the screen with black box's
Local j
For j = 0 To Int(MM.HRes / 2) + 2 Step 2
Line(j,j)-(MM.HRes - j,MM.VRes - j),0,b
Pause 15
Next j
For j = Int(MM.HRes / 2) + 2 To 0 Step -1
Line(j,j)-(MM.HRes - j,MM.VRes - j),0,b
Pause 10
Next j
End Sub
COLOUR-1.BASWill draw random circles filled with colour
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Demonstration of Colour MMBasic
' Geoff Graham, June 2012
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If MM.Device$ <> "Colour Maximite" Then
Print "This demonstration is intended to run on a Colour Maximite"
End
EndIf
Mode 3
Cls
cx = MM.HRes/2 : cy = MM.VRes/2
' draw random circles with smaller circles near to the centre
Do
x = Rnd * MM.HRes ' horiz center of the circle
y = Rnd * MM.VRes ' vert center of the circle
Do
c = Int(Rnd * 6) + 1 ' the colour
Loop Until Pixel(x, y) <> c ' must be different
d = Sqr(Abs(x-cx)^2 + Abs(y-cy)^2) ' distance from the centre
r = Rnd * d/8 + 2 + d/14 ' radius
Circle (x,y), r, c, f ' draw the sphere
If r > Rnd*8 + 13 Then Circle (x,y), r+1, 0 ' draw the edge in black
If Inkey$ <> "" Then End
Loop
COLOUR-2.BAS Will show how the MODE command can be used
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Demonstration of the colour modes in Colour MMBasic
' Geoff Graham May 2012
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Data "Black ", " Blue ", "Green ", " Cyan "
Data " Red ", "Purple", "Yellow", "White "
Data Red, Yellow, Green, Red, Blue, Purple, Red, Cyan, White
Data Green, Cyan, Blue, Green, Purple, White, Yellow, Blue, White
Dim c$(8)
Dim p(9, 2)
For i = 0 To 7: Read c$(i) : Next
For i = 1 To 6: For j = 0 To 2 : Read p(i, j) : Next i, j
Option usb off
Cls
mspc = 31
Mode 3
Colour 7
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print "Monochrome Mode";
Line (0, MM.VPos+10)-(MM.HPos-2, MM.VPos+10), 7
Locate 0, MM.VPos + 5
Print "Any one colour can be selected for all output:"
Locate 0, MM.VPos + 5
For i = Blue To White
Colour i
Print " MODE 1," Str$(i) " ";
Next
Print
For i = Blue To White
Colour i
Print " " c$(i) " ";
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print @(0, MM.VPos + mspc) "Four colour mode";
Line (0, MM.VPos+10)-(MM.HPos-2, MM.VPos+10), 7
Locate 0, MM.VPos + 5
Print "Six colour palettes to chose from."
Print "Each palette consists of three colours plus black:" ;
For i = 1 To 6
Print @(20, MM.VPos + 17) "Palette" i " MODE 2," Str$(i) " ";
For j = 0 To 2
Colour Black, p(i, j)
Print " ";
Colour White, Black
Print " ";
Next
Print " (";
For j = 0 To 2
Colour p(i, j)
Print " " c$(p(i, j)) " ";
Next
Colour White
Print ")";
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print @(0, MM.VPos + mspc) "Eight colour mode";
Line (0, MM.VPos+10)-(MM.HPos-2, MM.VPos+10), 7
Locate 0, MM.VPos + 5
Print "MODE 3 All colours can be used simultaneously"
line3 = MM.VPos
height3 = 40
For i = 0 To MM.HRes
If (i \ (MM.HRes\8)) + 1 > 7 Then Exit For
Line (i, line3)-(i + height3, line3 + height3), (i \ (MM.HRes\8)) + 1
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print @(0, MM.VPos + mspc) "240x216 eight colour mode";
Line (0, MM.VPos+10)-(MM.HPos-2, MM.VPos+10), 7
Locate 0, MM.VPos + 5
Print "MODE 4 (press any key to exit):"
Font 1, 2
p$ = " All Eight Colours 240x216 Pixels"
p$ = p$ + Chr$(13) + Chr$(10) + " High Speed Maximum Free Memory"
line4 = MM.VPos
Do
Locate 0, line4
For i = 1 To Len(p$)
Colour (Rnd * 6) + 1
Print Mid$(p$, i, 1);
If i Mod 12 = 0 Then
BLIT 0, line3, 1, line3, MM.HRes-2, height3 + 1
BLIT MM.HRes - 2, line3, 0, line3, 1, height3 + 1
EndIf
Next i
Loop Until Inkey$ <> ""
Colour White
Option usb on
Print
' SaveBMP "t.bmp"
MUSIC.BASWill play a sequence of music files First it will copy the files to drive A: Then it will play the first. To play the next press space.
NOTE: The three MOD files are in the MODs.zip file in the attachments ("urethra" Franklin LOL).
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Demonstration of the music playing ability of the Maximite
'
' Geoff Graham July 2012
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' First, check if the MOD files are on drive A: and if not. copy them
'
For i = 1 To 3
Option error continue
Open "A:T" + Chr$(48 + i) + ".Mod" For input As #1
If MM.Errno Then
Option error abort
If i = 1 Then
Print "This program will copy three files to drive A:"
Print "The screen will go blank for a while so please be patient"
Input "Press ENTER to continue...", t$
EndIf
Copy "B:T" + Chr$(48 + i) + ".Mod" To "A:"
Else
Option error abort
Close #1
EndIf
Next i
' Play each file in a repeating sequence
i = 1
Do
PlayMOD "A:T" + Chr$(48 + i) + ".Mod"
Cls : Colour 6 : Print "Playing: " "T" + Chr$(48 + i) + ".MOD"
Print "Press any key to select the next file or CTRL-C to halt..."
Print
Print "While the music is playing MMBasic will calculate the table of prime numbers."
Print "This ";
Print "demonstrates that the music is being synthesised in the background."
Print
GoSub DoPrimes
' Do : Loop While Inkey$ = ""
i = i + 1
If i > 3 Then i = 1
Loop
' Calculate the table of prime numbers
' Return to the caller if any key has been pressed
'
DoPrimes:
Colour 2
n = 1
Print " 2";
Do
skip:
n = n + 2
For d = 3 To Sqr(n)
If Inkey$ <> "" Then Return
If n Mod d = 0 Then GoTo skip
Next d
Print " " Format$(n, "%7g");
If MM.VPos > MM.VRes - 36 Then
BLIT 0, 84, 0, 72, MM.HRes, MM.VRes - 84
Option usb off
Locate MM.HPos, MM.VPos - 12
Option usb on
EndIf
Loop
JULIA.BASThis will plot the Julia set on the Colour Maximite. The Julia set is mathematically similar to the more famous Mandelbrot set and can generate some beautiful images. Be patient as it takes about 15 minutes to calculate. For more see:
http://www.thebackshed.com/forum/forum_posts.asp?TID=5103
'JULIA.BAS - Draws Julia set fractal images
'by loki
Mode 3
Cls
'Specify initial values
RealOffset = -1.30
ImaginOffset = -1.22
'------------------------------------------------*
'Set the Julia set constant [eg C = -1.2 + 0.8i]
CRealVal = -0.78
CImagVal = -0.20
'------------------------------------------------*
MAXIT=80 'max iterations
PixelWidth = MM.HRes
PixelHeight = MM.VRes
GAP = PixelHeight / PixelWidth
SIZE = 2.50
XDelta = SIZE / PixelWidth
YDelta = (SIZE * GAP) / PixelHeight
'Loop processing - visit every pixel
For X = 0 To (PixelWidth - 1)
CX = X * Xdelta + RealOffset
For Y = 0 To (PixelHeight - 1)
CY = Y * YDelta + ImaginOffset
Zr = CX
Zi = CY
COUNT = 0
'Begin Iteration loop
Do While (( COUNT <= MAXIT ) And (( Zr * Zr + Zi * Zi ) < 4 ))
new_Zr = Zr * Zr - Zi * Zi + CRealVal
new_Zi = 2 * Zr * Zi + CImagVal
Zr = new_Zr
Zi = new_Zi
COUNT = COUNT + 1
Loop
Pixel(X,Y) = COUNT Mod 8
Next Y
Next X
Do
a$ = Inkey$
Loop While a$ = ""