' SLI test program written using POWER basic 3.2
'
' Demo compiler available from  http://www.powerbasic.com/
'
' Freeware written by Mick Gulovsen  ( bigmik@blaze.net.au )
'
' v 1.1 --- added support for 12 character output
'
' v 1.2/1.3 development trials
' v 1.4 added LCD graphic capability
' v 1.5 added on screen representation of LCD module
' v 1.6 corrected minor display error when GFX test cycles from 9999 to 0
' v 1.7 clear screen on exit. Display warning on High Baud rates
'

$STRING 1                               ' switches to decrease EXE size
$LIB ALL OFF                            '               "
$LIB COM ON                             '               "

color 15,0                              ' white on black

cport$="COM1:"                          ' default Com port
send$="x"                               ' default send A-Z
baud=9600                               ' default Baud rate

on error goto goterror                  ' test for error


menu:


'**********  Display menu  **************

cls:? " SLI test v 1.7    Freeware by Mick Gulovsen   12-Jan-97 ";

locate 7,7:?"ΙΝΝΝΝΝΝ Baudrates: ΝΝΝΝΝΝΝΝ»";
for x=8 to 16
locate x,7:?"Ί                          Ί";
locate 17,7:?"ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ";
next x

locate 6,57:?"ΙΝ Com Port: Ν»";
for x=7 to 12
locate x,57:?"Ί             Ί";
locate 13,57:?"ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΌ";
next x

locate 15,52:?"ΙΝΝΝΝΝΝ Test Types: ΝΝΝΝΝΝΝ»";
for x=16 to 22
locate x,52:?"Ί                          Ί";
locate 23,52:?"ΘΝΝ Product of Australia ΝΝΌ";
next x


'**** Display options with current selections in highlight  *****

if baud=75 then color 0,7
locate 9,9: ?" 1 - 75 ";:color 15,0
if baud=110 then color 0,7
locate 10,9: ?" 2 - 110 ";:color 15,0
if baud=150 then color 0,7
locate 11,9: ?" 3 - 150 ";:color 15,0
if baud=300 then color 0,7
locate 12,9: ?" 4 - 300 ";:color 15,0
if baud=600 then color 0,7
locate 13,9: ?" 5 - 600 ";:color 15,0
if baud=1200 then color 0,7
locate 14,9: ?" 6 - 1200 ";:color 15,0
if baud=1800 then color 0,7
locate 15,9: ?" 7 - 1800 ";:color 15,0
if baud=2400 then color 0,7
locate 9,21: ?" 8 - 2400 ";:color 15,0
if baud=4800 then color 0,7
locate 10,21: ?" 9 - 4800 ";:color 15,0
if baud=9600 then color 0,7
locate 11,21: ?" a - 9600 ";:color 15,0
if baud=19200 then color 0,7
locate 12,21: ?" b - 19200 ";:color 15,0
if baud=38400 then color 0,7
locate 13,21: ?" c - 38400 ";:color 15,0
if baud=57600 then color 0,7
locate 14,21: ?" d - 57600 ";:color 15,0
if baud=115200 then color 0,7
locate 15,21: ?" e - 115200 ";:color 15,0

locate 21,15: ?"ENTER - Run Test";
locate 22,17: ?"ESC - EXIT";

if cport$="COM1:" then color 0,7
locate 8,59: ?" v - COM1: ";:color 15,0
if cport$="COM2:" then color 0,7
locate 9,59: ?" w - COM2: ";:color 15,0
if cport$="COM3:" then color 0,7
locate 10,59: ?" x - COM3: ";:color 15,0
if cport$="COM4:" then color 0,7
locate 11,59: ?" y - COM4: ";:color 15,0
if send$="L" then color 0,7
locate 17,54: ?" l - Send A-L (12 Chrs) ";:color 15,0
if send$="O" then color 0,7
locate 18,54: ?" o - Send A-O (15 Chrs) ";:color 15,0
if send$="P" then color 0,7
locate 19,54: ?" p - Send A-P (16 Chrs) ";:color 15,0
if send$="Z" then color 0,7
locate 20,54: ?" z - Send A-Z (26 Chrs) ";:color 15,0
if send$="x" then color 0,7
locate 21,54: ?" u - Send graphics test ";:color 15,0



loop2:

a$=inkey$:if a$="" then loop2:          ' wait for keypress
a$=chr$(asc(a$) OR 32 )                 ' convert to lower case only

' *******  act on keypress  ***********
if a$="1" then baud=75    : goto menu:
if a$="2" then baud=110   : goto menu:
if a$="3" then baud=150   : goto menu:
if a$="4" then baud=300   : goto menu:
if a$="5" then baud=600   : goto menu:
if a$="6" then baud=1200  : goto menu:
if a$="7" then baud=1800  : goto menu:
if a$="8" then baud=2400  : goto menu:
if a$="9" then baud=4800  : goto menu:
if a$="a" then baud=9600  : goto menu:
if a$="b" then baud=19200 : goto menu:
if a$="c" then baud=38400 : goto menu:
if a$="d" then baud=57600 : goto menu:
if a$="e" then baud=115200: goto menu:
if a$="l" then send$ = "L":goto menu:
if a$="o" then send$ = "O":goto menu:
if a$="p" then send$ = "P":goto menu:
if a$=";" then cls:end
if a$="u" then send$ = "x":goto menu:
if a$="v" then cport$ = "COM1:":goto menu:
if a$="w" then cport$ = "COM2:":goto menu:
if a$="x" then cport$ = "COM3:":goto menu:
if a$="y" then cport$ = "COM4:":goto menu:
if a$="z" then send$ = "Z":goto menu:
if a$=chr$(45) then goto test:

goto menu:                              ' if key not in list return

test:

if baud>9600 then gosub warnbaud:	' display warning for fast speeds.

open cport$+str$(baud)+",N,8,1 ,cs,ds" as 1     ' open comport for output

delay (.5)                              ' delay to enable comport to
                                        ' stabilise maybe not needed

'******* draw sample LCD ********

locate 19,7:?"ΙΝΝΝΝ Sample Display ΝΝΝΝ» ";
for x=20 to 23
locate x,7:?"Ί                        Ί ";
locate 24,7:?"ΘΝΝΝ Any key to exit ΝΝΝΝΌ ";
next x

print#1,chr$(13);                       ' send CR to SLI to autobaud

delay(.5)                               ' delay to enable sign on routine
                                        ' to settle. maybe not needed

if send$="x" then goto test1:           ' test to see if GFX test

locate 21,12                            ' position cursor in sample area

for mick= asc("A") to asc(send$)        ' Print ASCII string to both
print#1,chr$(mick);                     ' SLI and video display
if mick=asc("Q") then locate 22,12      '
?chr$(mick);                            '
next mick                               '
?"_";                                   '


loop1:

a$=inkey$:if a$="" then loop1:          ' await keypress

loop3:

close 1                                 ' turn off SLI

goto menu:

test1:

print#1,chr$(254);chr$(12);             ' turn off cursor (SLI)


'******  program graphic characters on SLI (CHR 0-5) *********

print#1,chr$(254);chr$(64);chr$(0);chr$(0);chr$(0);chr$(0);chr$(0);chr$(0);chr$(0);chr$(0);
print#1,chr$(254);chr$(72);chr$(16);chr$(16);chr$(16);chr$(16);chr$(16);chr$(16);chr$(16);chr$(16);
print#1,chr$(254);chr$(80);chr$(24);chr$(24);chr$(24);chr$(24);chr$(24);chr$(24);chr$(24);chr$(24);
print#1,chr$(254);chr$(88);chr$(28);chr$(28);chr$(28);chr$(28);chr$(28);chr$(28);chr$(28);chr$(28);
print#1,chr$(254);chr$(96);chr$(30);chr$(30);chr$(30);chr$(30);chr$(30);chr$(30);chr$(30);chr$(30);
print#1,chr$(254);chr$(104);chr$(31);chr$(31);chr$(31);chr$(31);chr$(31);chr$(31);chr$(31);chr$(31);

loop4:

count=0                         ' start counting at 0
quit=0                          ' clear quit flag

loop5:

print#1,chr$(254);chr$(128);" 00% At";baud;  ' point to start of display ram

locate 21,12:?" 00% At";baud;           ' display current %
for x = 0 to 99
gosub dispgfx:                          ' display GFX bar
incr count
if quit=1 then goto loop3:              ' exit display routine
if count=9999 then goto loop4:          ' reset to 0000
disp$=str$(x+1)

if x<10 then disp$=" 00"
if x=99 then disp$="100"
if x=9 then disp$=" 10"
disp1$=disp$:if disp$=" 00" then disp1$="00"

if (x+1)/10=int((x+1)/10) then print#1,chr$(254);chr$(128);disp$;"% At";baud;:locate 21,12:?disp1$;"% At";baud;
next x

for x=99 to 0 step-1
gosub dispgfx:
incr count
if quit=1 then goto loop3:      ' exit display routine
if count=9999 then goto loop4:
disp$=str$(x+1)


if x<10 then disp$=" 00"
if x=99 then disp$="100"
if x=9 then disp$=" 10"
disp1$=disp$:if disp$=" 00" then disp1$="00"

if (x+1)/10=int((x+1)/10) then print#1,chr$(254);chr$(128);disp$;"% At";baud;:locate 21,12:?disp1$;"% At";baud;

next x

goto loop5:

chktst:                                 ' print GFX chr

if tst<1 then print#1,chr$(0);:?" ";
if tst=1 then print#1,chr$(1);:?" ";
if tst=2 then print#1,chr$(2);:?"έ";
if tst=3 then print#1,chr$(3);:?"έ";
if tst=4 then print#1,chr$(4);:?"Ϋ";
if tst=5 then print#1,chr$(5);:?"Ϋ";

return

dispgfx:

print#1,chr$(254);chr$(192);            ' point to 2nd line

' ******** print GFX bar ********

locate 22,12
if x>9 then print#1,chr$(5); else tst=int(x/2):gosub chktst:
if x>9 then print"Ϋ";
if (x-10)>9 then print#1,chr$(5); else tst=int((x-10)/2):gosub chktst:
if (x-10)>9 then print"Ϋ";
if (x-20)>9 then print#1,chr$(5); else tst=int((x-20)/2):gosub chktst:
if (x-20)>9 then print"Ϋ";
if (x-30)>9 then print#1,chr$(5); else tst=int((x-30)/2):gosub chktst:
if (x-30)>9 then print"Ϋ";
if (x-40)>9 then print#1,chr$(5); else tst=int((x-40)/2):gosub chktst:
if (x-40)>9 then print"Ϋ";
if (x-50)>9 then print#1,chr$(5); else tst=int((x-50)/2):gosub chktst:
if (x-50)>9 then print"Ϋ";
if (x-60)>9 then print#1,chr$(5); else tst=int((x-60)/2):gosub chktst:
if (x-60)>9 then print"Ϋ";
if (x-70)>9 then print#1,chr$(5); else tst=int((x-70)/2):gosub chktst:
if (x-70)>9 then print"Ϋ";
if (x-80)>9 then print#1,chr$(5); else tst=int((x-80)/2):gosub chktst:
if (x-80)>9 then print"Ϋ";
if (x-90)>9 then print#1,chr$(5); else tst=int((x-90)/2):gosub chktst:
if (x-90)>9 then print"Ϋ";

if inkey$<>"" then quit=1:return        ' key pressed to exit

count$=str$(count)                      ' eliminate space at end of #

cnt$=string$((5-len(count$))," ")       ' tag spaces onto end of # count
print#1,count$;cnt$;:?count$;cnt$;      '

return


warnbaud:				' warning on fast speeds


locate 19,8				' position cursor
?"NOTE!! speeds above 9600";            ' and display warning
locate 20,7				' message in sample display
?"may miss characters due to";
locate 21,7
?"lack of hardware handshake.";
locate 22,7
?"especially in Graphics mode";
color 31,0				' flash mode on
locate 24,7:?"ESC - redo ... ENTER - test";		' display key msg.

color 15,0

warnloop:				' wait till key pressed
a$=inkey$                               '
if a$="" then warnloop:                 '
if a$=chr$(27) then menu:		' ESC pressed
if a$=chr$(13) then return		' ENTER pressed
goto warnloop:				' invalid key pressed

goterror:                               ' Error trap routine

ecode=errtest                           ' Capture Error code No.

color 31,0					' clear possible
for x=19 to 24                                  ' >9600 warning
locate x,7:?"                           ";      ' msg
next x                                          '
locate 21,15
if ecode=68 then ?cport$;" NOT PRESENT ";
if ecode<>68 then ?"unknown error";

locate 22,17:?"Press any key";

color 15,0
errloop:                                        ' wait for key press
a$=inkey$                                       '
if a$="" then errloop:                          '

resume menu:					' return to program


end						' Tada.....

