' Pi Pico VGA colour test card V0.4
 ' Original test card for CMM2
 ' Written by TassyJim August 2020
 ' Adapted for Pi Pico VGA July 2022
 ' PiPico has only 2 modes
 ' MODE 1 640X480 monochrome (no greyscale)
 ' MODE 2 320X240 16 colours RGB(121)
 Option EXPLICIT
 Option DEFAULT NONE
 Dim INTEGER wd, ht, wbox, sh, x, w, n, nn, m, mp, cd, maxMode, keepMode
 Dim FLOAT a, defaultMode
 Dim k$, imgtitle$, fname$, imgRes$, pages$
 Dim INTEGER c(16)
 c(0) = RGB(BLACK)
 c(1) = RGB(MYRTLE)
 c(2) = RGB(MIDGREEN)
 c(3) = RGB(GREEN)
 c(4) = RGB(RED)
 c(5) = RGB(RUST)
 c(6) = RGB(BROWN)
 c(7) = RGB(YELLOW)
 c(8) = RGB(BLUE)
 c(9) = RGB(COBALT)
 c(10) = RGB(CERULEAN)
 c(11) = RGB(CYAN)
 c(12) = RGB(MAGENTA)
 c(13) = RGB(FUCHSIA)
 c(14) = RGB(LILAC)
 c(15) = RGB(WHITE)

 maxMode = 2                   'originally 12
 cd = 8
 a = 1
 defaultMode = 1               'MM.Info(MODE)
 mp = 1                        'MM.Info(MAX PAGES)
 CLS

 Do
   If m = 0 Then
     MODE 1',8
     CLS
     Text 320,100, "Video mode test",cm,5,1
     Text 320,180, "Ratio = aspect ratio used in the circle command",cm,1,1
     Text 320,220, "Q to quit, P to save page as a BMP",cm,3,1
     Text 320,260, "Up Down arrow to change resolution",cm,3,1
     'Text 320,300, "Left Right arrow to change colour depth",cm,3,1
     Text 320,340, "+ - to change circle aspect ratio",cm,3,1
   Else
     If keepmode Then ' only change resolution if needed
       keepmode = 0
     Else
       MODE m',cd
       mp = 1                  'MM.Info(MAX PAGES)
     EndIf
     wd = MM.HRes : ht = MM.VRes
     nn = Int(wd/80)
     imgtitle$ =" MODE "+Str$(m)+" Ratio "+Str$(a,1,3)+" "
     'imgtitle$ =" MODE "+Str$(MM.Info(MODE))+" Ratio "+Str$(a,1,3)+" "
     imgRes$ = " "+Str$(MM.HRes)+" x "+Str$(MM.VRes)+" "
     'pages$ = " Maximum page number = "+Str$(mp)+" "
     wbox = wd / 16
     'If mp > 0 Then ' mode 11,16 and 12,16 only have page 0
     '  PAGE WRITE 1 ' no flicker during write
     'EndIf
     CLS
     ' primary colours
     For x = 0 To 15
       Box x*wbox,ht/4,wbox,ht/2,0,c(x), c(x)
     Next x

     ' full gradient for each primary colour and greyscale
     'greens
       Box 0,0,wd/4,ht/12,1,c(0),c(0)
       Box wd/4,0,wd/2,ht/12,1,c(1),c(1)
       Box wd/2,0,wd*3/4,ht/12,1,c(2),c(2)
       Box wd*3/4,0,wd,ht/12,1,c(3),c(3)

     'reds
       Box 0,ht/12,wd/4,ht/12,1,c(4),c(4)
       Box wd/4,ht/12,wd/2,ht/12,1,c(5),c(5)
       Box wd/2,ht/12,wd*3/4,ht/12,1,c(6),c(6)
       Box wd*3/4,ht/12,wd,ht/12,1,c(7),c(7)

     'blues
       Box 0,ht/6,wd/4,ht/12,1,c(8),c(8)
       Box wd/4,ht/6,wd/2,ht/12,1,c(9),c(9)
       Box wd/2,ht/6,wd*3/4,ht/12,1,c(10),c(10)
       Box wd*3/4,ht/6,wd,ht/12,1,c(11),c(11)

     'magentas
       Box 0,ht*9/12,wd/4,ht/12,1,c(12),c(12)
       Box wd/4,ht*9/12,wd/2,ht/12,1,c(13),c(13)
       Box wd/2,ht*9/12,wd*3/4,ht/12,1,c(14),c(14)
       Box wd*3/4,ht*9/12,wd,ht/12,1,c(15),c(15)

     'greyscale
       Box 0,ht*10/12,wd/2,ht/12,1,c(0),c(0)
       Box wd/2,ht*10/12,wd/2,ht/12,1,c(15),c(15)

     ' circle to check aspect ratio
     Circle wd/2,ht/2, ht*15/32,2,a,c((m-1)*15)
     sh = 0
     x = wd/2 - 55*nn/2
     ' black white bars to check monitor bandwidth
     For w = 10 To 1 Step -1
       For n = 1 To nn
         sh = 255 - sh
         Line x,ht*3/8,x,ht*5/8,w,RGB(sh,sh,sh)
         x = x + w
       Next n
     Next w
     ' white and red border to check that image fits on monitor
     Box 0,0,wd,ht,3,c(7)
     Box 1,1,wd-2,ht-2,1,c(5)
     ' title
     If wd > 600 Then
       Text wd/2,ht/2-15, imgtitle$,cm,4,1
       Text wd/2,ht/2, pages$,cm,4,1
       Text wd/2,ht/2+15, imgRes$,cm,4,1
     Else
       Text wd/2,ht/2-11, imgtitle$,cm,1,1
       Text wd/2,ht/2, pages$,cm,1,1
       Text wd/2,ht/2+11, imgRes$,cm,1,1
     EndIf
     ' show the new image
     'If m < 11 Or cd = 8 Then
     '  PAGE COPY 1 To 0 ,B
     'EndIf
   EndIf
   ' wait for keypress
   Do
     k$ = Inkey$
   Loop Until k$<>""
   '
   Select Case k$
     Case "Q","q"
       Exit
     Case "P","p"
       fname$ = Mid$(imgtitle$,2)+".bmp"
       Timer = 0
       Save IMAGE fname$
      ' PAGE WRITE 0
       Text wd/2,ht/3,"Saved as "+fname$,cm,1,1
       Do
         k$ = Inkey$
       Loop Until k$<>""
     Case Chr$(128) ' up arrow
       m = m - 1
       If m < 1 Then m = maxMode
       'If (m = 9 Or m = 11 Or m = 12) And cd = 12 Then cd = 8 ' skip 12 bit for mode 9 11 12
     Case Chr$(129) ' down arrow
       m = m + 1
       If m > maxMode Then m = 1
       'If (m = 9 Or m = 11 Or m = 12) And cd = 12 Then cd = 8 ' skip 12 bit for mode 9 11 12
     Case Chr$(131) ' right arrow res up
       Colour RGB(yellow),RGB(blue)
    '   cd = cd + 4
    '   If cd > 16 Then cd = 8
    '   If (m = 9 Or m = 11 Or m = 12) And cd = 12 Then cd = 16 ' skip 12 bit for mode 9 11 12
     Case Chr$(130) ' left arrow  res down
       Colour RGB(white),RGB(black)
    '   cd = cd - 4
    '   If cd < 8 Then cd = 16
    '   If (m = 9 Or m = 11 Or m = 12) And cd = 12 Then cd = 8 ' skip 12 bit for mode 9 11 12
     Case "+" ' ratio plus
       If a < 1.4 Then a = a + 0.01
       keepmode = 1
     Case "-" ' ratio minus
       If a > 0.75 Then a = a - 0.01
       keepmode = 1
     Case Else ' same as down arrow
       m = m + 1
       If m > maxMode Then m = 1
   End Select
 Loop
 setmode defaultMode ' restore original mode before ending program
 ' PAGE WRITE 0
 CLS

End

Sub setmode dotMode As FLOAT
 Local INTEGER mm, md
 ' use float returned by mm.info(mode) to set MODE
 mm = Int(dotmode)
 md = (dotmode - mm)*100
 If md > 20 Then md = md/10
 MODE mm, md
End Sub