Colour Demos

Modified on 2016/12/23 23:25 by Administrator — Categorized as: Graphics, Maths, Sounds, _LIB Original MMBasic

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.BAS
A 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.BAS
Will 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.BAS
Will 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.BAS
This 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$ = ""