'ProgramMode:GB1
' Kraepelin Inspection
' Version 1.0   for CG
' 2018.07.21
' Copyright (C)2018 Colon
'
System((-)1)<10=>Stop
RefrshCtrl 2
RefrshTime 0

SysCall(0X2B7,0
SysCall(0X2B8,3,3,0,0
If Version<47:Then 
"Your C.Basic for CG"
"Version does not"
"support this program."
"Upgrade C.Basic to"
"  Ver 0.47_#E640_ or later."
Blue Locate 10,7,"Press [EXIT]"
Do
SysCall(0X2B7,0
SysCall(0X1D81
LpWhile Getkey1<>47
ClrText
Stop
IfEnd

'#G3M
'#CBDBL
'#_Mat _1
Norm 0
Lbl 0
ClrMat 
ClrText
SysCall(0X2B7,0
SysCall(0X2B8,3,3,0,0

Blue "Kraepelin Inspection"
Green "         Version 1.0"
""
"Start:[EXE]"
"Quit :[EXIT]"

Do
SysCall(0X2B7,0
SysCall(0X1D81
Getkey1->K
K=47=>ClrTextStop
LpWhile K<>31

SysCall(0X32,20,0
SysCall(0X1D81
_DispVram
1000->Dim List 1.B
1000->Dim List 2.B
1000->Dim List 3.B
(-)1->List 3
0->List 3[1]
RanInt#(3,9)->List 1[1]
For 2->A To 1000
RanInt#(3,9)->List 1[A]
MOD(List 1[A-1]+List 1[A],10)->List 2[A]
Next

ClrText
Blue "Kraepelin Inspection"
Green Locate 1,2,"001//_#E5D9__#E5D9__#E5D9_"
Red Locate 13,2,"[   sec]"


For 1->A To 8
Locate 5+2A,4,List 1[A]
Next
Locate 8,5,"_@00D8_"

1->A
(-)60*128->%

Do
Getkey->K
K=47=>Break
MOD(K,10)->a
Int (K/10)->b
If (2<=a And a<=4 And b>=5) Or K=71
Then 3a-b+2->c
c=(-)2=>0->c
c->List 3[A+1]

Isz A
A=1000=>Break

Locate 1,4," "
Locate 2,5," "

_Hscroll (-)36,0,72,377,119
Green Locate 1,2,Sprintf("%03d",%A)
Locate 8,5,"_@00D8_"
Locate 6,5,c
Locate 21,4,List 1[A+7
PutDispDD
While Getkey
WhileEnd
IfEnd

Abs Intg (%/128)->T
Red Locate 14,2,Sprintf("%02d",%T)
PutDispDD
LpWhile T
0->K
While Getkey
WhileEnd
T=>Goto 0

ClrText
SysCall(0X2B7,0
SysCall(0X2B8,3,3,0,0

0->d
0->e
For 2->B To A
List 2[B]=List 3[B]=>Isz d
List 2[B]<>List 3[B]=>Isz e
Next

Blue "Kraepelin Inspection"
""
Red " _#E6A3_"
Blue " _#E5AF_"
""
" Press:[EXIT]"
Locate 3,3,":"
Locate 3,4,":"
Locate 4,3,d
Locate 4,4,e

Do
SysCall(0X2B7,0
SysCall(0X1D81
Getkey1->K
LpWhile K<>47
Goto 0