fl                                                              
{
PropForth 5.5      

Simple Game
          
P0-P7 --- CharliePlexing 8x8DotMatrix 
P8 ------ buzzar
P9 ------ SW
3.3V ---- 3.3V
GND ----- GND

2015/01/01 20:12:51

}

\ =========================================================================== 
\ Constants 
\ =========================================================================== 

\ ----- 8X8 Font Characters -----
wvariable Font -2 allot
h00 c, h00 c, h00 c, h00 c, h00 c, h00 c, h00 c, h00 c,      
h00 c, h06 c, h5F c, h5F c, h06 c, h00 c, h00 c, h00 c,
h00 c, h03 c, h07 c, h00 c, h07 c, h03 c, h00 c, h00 c,
h14 c, h7F c, h7F c, h14 c, h7F c, h7F c, h14 c, h00 c,
h24 c, h2E c, h2A c, h6B c, h6B c, h3A c, h12 c, h00 c,
h46 c, h66 c, h30 c, h18 c, h0C c, h66 c, h62 c, h00 c,
h30 c, h7A c, h4F c, h5D c, h37 c, h7A c, h48 c, h00 c,
h00 c, h04 c, h07 c, h03 c, h00 c, h00 c, h00 c, h00 c,
h00 c, h1C c, h3E c, h63 c, h41 c, h00 c, h00 c, h00 c,
h00 c, h41 c, h63 c, h3E c, h1C c, h00 c, h00 c, h00 c,
h08 c, h2A c, h3E c, h1C c, h1C c, h3E c, h2A c, h08 c,
h08 c, h08 c, h3E c, h3E c, h08 c, h08 c, h00 c, h00 c,
h00 c, h80 c, hE0 c, h60 c, h00 c, h00 c, h00 c, h00 c,
h08 c, h08 c, h08 c, h08 c, h08 c, h08 c, h00 c, h00 c,
h00 c, h00 c, h60 c, h60 c, h00 c, h00 c, h00 c, h00 c,
h60 c, h30 c, h18 c, h0C c, h06 c, h03 c, h01 c, h00 c,
h3E c, h7F c, h41 c, h49 c, h41 c, h7F c, h3E c, h00 c,     \ h30 "0"
h40 c, h42 c, h7F c, h7F c, h40 c, h40 c, h00 c, h00 c,
h62 c, h73 c, h59 c, h49 c, h6F c, h66 c, h00 c, h00 c,
h22 c, h63 c, h49 c, h49 c, h7F c, h36 c, h00 c, h00 c,
h18 c, h1C c, h16 c, h53 c, h7F c, h7F c, h50 c, h00 c,
h27 c, h67 c, h45 c, h45 c, h7D c, h39 c, h00 c, h00 c,
h3C c, h7E c, h4B c, h49 c, h79 c, h30 c, h00 c, h00 c,
h03 c, h03 c, h71 c, h79 c, h0F c, h07 c, h00 c, h00 c,
h36 c, h7F c, h49 c, h49 c, h7F c, h36 c, h00 c, h00 c,
h06 c, h4F c, h49 c, h69 c, h3F c, h1E c, h00 c, h00 c,
h00 c, h00 c, h66 c, h66 c, h00 c, h00 c, h00 c, h00 c,
h00 c, h80 c, hE6 c, h66 c, h00 c, h00 c, h00 c, h00 c,
h08 c, h1C c, h36 c, h63 c, h41 c, h00 c, h00 c, h00 c,
h24 c, h24 c, h24 c, h24 c, h24 c, h24 c, h00 c, h00 c,
h00 c, h41 c, h63 c, h36 c, h1C c, h08 c, h00 c, h00 c,
h02 c, h03 c, h51 c, h59 c, h0F c, h06 c, h00 c, h00 c,
h3E c, h7F c, h41 c, h5D c, h5D c, h1F c, h0E c, h00 c,
h7C c, h7E c, h13 c, h13 c, h7E c, h7C c, h00 c, h00 c,
h41 c, h7F c, h7F c, h49 c, h49 c, h7F c, h36 c, h00 c,
h1C c, h3E c, h63 c, h41 c, h41 c, h63 c, h22 c, h00 c,
h41 c, h7F c, h7F c, h41 c, h63 c, h3E c, h1C c, h00 c,
h41 c, h7F c, h7F c, h49 c, h5D c, h41 c, h63 c, h00 c,
h41 c, h7F c, h7F c, h49 c, h1D c, h01 c, h03 c, h00 c,
h1C c, h3E c, h63 c, h41 c, h51 c, h73 c, h72 c, h00 c,
h7F c, h7F c, h08 c, h08 c, h7F c, h7F c, h00 c, h00 c,
h00 c, h41 c, h7F c, h7F c, h41 c, h00 c, h00 c, h00 c,
h30 c, h70 c, h40 c, h41 c, h7F c, h3F c, h01 c, h00 c,
h41 c, h7F c, h7F c, h08 c, h1C c, h77 c, h63 c, h00 c,
h41 c, h7F c, h7F c, h41 c, h40 c, h60 c, h70 c, h00 c,
h7F c, h7F c, h0E c, h1C c, h0E c, h7F c, h7F c, h00 c,
h7F c, h7F c, h06 c, h0C c, h18 c, h7F c, h7F c, h00 c,
h1C c, h3E c, h63 c, h41 c, h63 c, h3E c, h1C c, h00 c,
h41 c, h7F c, h7F c, h49 c, h09 c, h0F c, h06 c, h00 c,
h1E c, h3F c, h21 c, h71 c, h7F c, h5E c, h00 c, h00 c,
h41 c, h7F c, h7F c, h09 c, h19 c, h7F c, h66 c, h00 c,
h26 c, h6F c, h49 c, h49 c, h7B c, h32 c, h00 c, h00 c,
h03 c, h41 c, h7F c, h7F c, h41 c, h03 c, h00 c, h00 c,
h7F c, h7F c, h40 c, h40 c, h7F c, h7F c, h00 c, h00 c,
h1F c, h3F c, h60 c, h60 c, h3F c, h1F c, h00 c, h00 c,
h7F c, h7F c, h30 c, h18 c, h30 c, h7F c, h7F c, h00 c,
h61 c, h73 c, h1E c, h0C c, h1E c, h73 c, h61 c, h00 c,
h07 c, h4F c, h78 c, h78 c, h4F c, h07 c, h00 c, h00 c,
h47 c, h63 c, h71 c, h59 c, h4D c, h67 c, h73 c, h00 c,
h00 c, h7F c, h7F c, h41 c, h41 c, h00 c, h00 c, h00 c,
h01 c, h03 c, h06 c, h0C c, h18 c, h30 c, h60 c, h00 c,
h00 c, h41 c, h41 c, h7F c, h7F c, h00 c, h00 c, h00 c,
h08 c, h0C c, h06 c, h03 c, h06 c, h0C c, h08 c, h00 c,
h80 c, h80 c, h80 c, h80 c, h80 c, h80 c, h80 c, h80 c,
h00 c, h00 c, h01 c, h03 c, h06 c, h04 c, h00 c, h00 c,
h20 c, h74 c, h54 c, h54 c, h3C c, h78 c, h40 c, h00 c,
h41 c, h7F c, h3F c, h48 c, h48 c, h78 c, h30 c, h00 c,
h38 c, h7C c, h44 c, h44 c, h6C c, h28 c, h00 c, h00 c,
h30 c, h78 c, h48 c, h49 c, h3F c, h7F c, h40 c, h00 c,
h38 c, h7C c, h54 c, h54 c, h5C c, h18 c, h00 c, h00 c,
h48 c, h7E c, h7F c, h49 c, h03 c, h02 c, h00 c, h00 c,
h98 c, hBC c, hA4 c, hA4 c, hF8 c, h7C c, h04 c, h00 c,
h41 c, h7F c, h7F c, h08 c, h04 c, h7C c, h78 c, h00 c,
h00 c, h44 c, h7D c, h7D c, h40 c, h00 c, h00 c, h00 c,
h60 c, hE0 c, h80 c, h80 c, hFD c, h7D c, h00 c, h00 c,
h41 c, h7F c, h7F c, h10 c, h38 c, h6C c, h44 c, h00 c,
h00 c, h41 c, h7F c, h7F c, h40 c, h00 c, h00 c, h00 c,
h7C c, h7C c, h08 c, h38 c, h0C c, h7C c, h78 c, h00 c,
h7C c, h7C c, h04 c, h04 c, h7C c, h78 c, h00 c, h00 c,
h38 c, h7C c, h44 c, h44 c, h7C c, h38 c, h00 c, h00 c,
h84 c, hFC c, hF8 c, hA4 c, h24 c, h3C c, h18 c, h00 c,
h18 c, h3C c, h24 c, hA4 c, hF8 c, hFC c, h84 c, h00 c,
h44 c, h7C c, h78 c, h4C c, h04 c, h1C c, h18 c, h00 c,
h48 c, h5C c, h54 c, h54 c, h74 c, h24 c, h00 c, h00 c,
h00 c, h04 c, h3E c, h7F c, h44 c, h24 c, h00 c, h00 c,
h3C c, h7C c, h40 c, h40 c, h3C c, h7C c, h40 c, h00 c,
h1C c, h3C c, h60 c, h60 c, h3C c, h1C c, h00 c, h00 c,
h3C c, h7C c, h60 c, h38 c, h60 c, h7C c, h3C c, h00 c,
h44 c, h6C c, h38 c, h10 c, h38 c, h6C c, h44 c, h00 c,
h9C c, hBC c, hA0 c, hA0 c, hFC c, h7C c, h00 c, h00 c,
h4C c, h64 c, h74 c, h5C c, h4C c, h64 c, h00 c, h00 c,
h08 c, h08 c, h3E c, h77 c, h41 c, h41 c, h00 c, h00 c,
h00 c, h00 c, h7F c, h7F c, h00 c, h00 c, h00 c, h00 c,
h41 c, h41 c, h77 c, h3E c, h08 c, h08 c, h00 c, h00 c,
h02 c, h03 c, h01 c, h03 c, h02 c, h03 c, h01 c, h00 c,
h4C c, h5E c, h73 c, h01 c, h73 c, h5E c, h4C c, h00 c,

\ ----- erase-bit-data for 8x8Matrix-dot -----
\ ----- upperbyte:index of matrix^array 
\ ----- lowerbyte:erase-bit-data
wvariable erase_bit -2 allot
h00FE w, h00FC w, h00F8 w, h00F0 w, h00E0 w, h00C0 w, h0080 w, h0000 w,
h017F w, h027F w, h037F w, h047F w, h057F w, h067F w, h077F w,
h073F w, h071F w, h070F w, h0707 w, h0703 w, h0701 w, h0700 w,
h067E w, h057E w, h047E w, h037E w, h027E w, h017E w,
h017C w, h0178 w, h0170 w, h0160 w, h0140 w, h0100 w,
h023E w, h033E w, h043E w, h053E w, h063E w,
h061E w, h060E w, h0606 w, h0602 w, h0600 w,
h053C w, h043C w, h033C w, h023C w,
h0238 w, h0230 w, h0220 w, h0200 w,
h031C w, h041C w, h051C w,
h050C w, h0504 w, h0500 w,
h0418 w, h0318 w,
h0310 w, h0300 w,
h0408 w, h0400 w,

h1F8	wconstant ctra
\ h1F9	wconstant ctrb 
h1FA	wconstant frqa
{
h1FB	wconstant frqb
h1FC wconstant phsa
h1FD wconstant phsb
}
8 wconstant buzzar
9 wconstant sw
sw >m constant swm

\ =========================================================================== 
\ Variables 
\ =========================================================================== 
\ Buffer for 8x8 LED-Matrix
variable matrix 4 allot 
wvariable sw_value
wvariable snd_value

\ =========================================================================== 
\ Main 
\ =========================================================================== 

\ Drive 8x8-LED-Matrix curcuit for Charlieplexing by assembler-word
\ It takes about 16msec displaying 8-lines.
\ ( n1 -- )  n1:address of 8x8-Matrix buffer
lockdict create _matrix_Charlie_asm forthentry
$C_a_lxasm w, h12E  h113  1- tuck - h9 lshift or here W@ alignl h10 lshift or l,
z2WyPW8 l, z2WiPfg l, z2WiPmB l, z2Wyxj0 l, z2WyxW0 l, z1Sy\Ka l, z2WixZD l, z2Wyxmy l,
z2WiPve l, z20iPyk l, z3ryPr0 l, ziPuE l, z2[iQ3F l, z24yQ01 l, z2WixZG l, z1Sy\Ka l,
zfyPb1 l, z20yPj1 l, z3[yP[M l, z1SV04J l, z2WiPvf l, z20iPyk l, z3ryPr0 l, z1SV000 l,
z38 l, zJY0 l, z1 l,
freedict

              
\ Clear matrix buffer
\ ( -- )
: clr_matrix 0 matrix L! 0 matrix 4+ L! ;

\ Fill matrix-array by 1
\ ( -- )
: fill_matrix hFFFFFFFF matrix L! hFFFFFFFF matrix 4+ L! ;


\ Shift Font-data from right to left inside buffer
\ matrix+7 <- matrix+6 <- matrix+5 <- matrix+4 <- matrix+3 <- matrix+2 <- matrix+1 <- matrix
\ ( -- )
: shift_data
matrix 7 +
7 0 do
     dup 1-              \ ( matrix+7 matrix+6 )
     C@ over C!          \  Shift data 
     1-     
loop
drop
;

: demo_asm
\ Clear buffer 
clr_matrix
c" matrix _matrix_Charlie_asm" 0 cogx

Font
d768 0 do
     dup
     shift_data
     C@ matrix C!
     1+
     d100 delms
loop
drop
0 cogreset
;

\ Display 1char
\ ( n1 -- ) n1:char-code
: disp_1char
h20 - 8 u* Font +
8 0 do
     dup 
     shift_data
     C@ matrix C!
     1+
     d125 delms
loop
drop
;

\ Display 1char without moving
\ ( n1 -- )
: char
h20 - 8 u* Font +
8 0 do
     dup
     C@ matrix 6 i - + C!
     1+
loop
drop
;

\ Seperate index and erase-bit-data
\ ( n1 -- n2 n3 )   n1:word  n2:erase-bit-data  n3:index
: seperate
dup                      \ ( n1 n1 )
hFF and swap             \ ( n2 n1 )
8 rshift                 \ ( n2 n3 )
;


\ Check switch-status
\ ( -- )
: sw
0 sw_value W!
begin
     \ Check if buttom is pushed(P9 is 0 when sw is pushed)
     swm ina COG@ and 0=       
     if
          \ Wait 10msec
          d10 delms
          swm ina and if 0 else 1 then
          if
               \ Set flag when bottun pushed
               1 sw_value W!
               \ Wait until buttom is release
               begin 
                    swm ina COG@ and
                    if
                         \ Wait 10msec
                         d10 delms
                         swm ina COG@ and if 1 else 0 then
                    else
                         0
                    then
               until
          then
     then     
0 until
;

\ Buzzar
\ ( n1 n2 -- )   n1:time  n2:FRQA value
: tone
\ Set NCO/PWM single-ended mode
h10000000 buzzar or ctra COG!             
frqa COG!
delms
0 frqa COG!
;

\ countdown sound
\ ( -- )
: call
d25 d37044 tone d50 delms     \ f=690Hz duration=25msec
d30 d37044 tone d168 delms    \ f=690Hz duration=168msec
d23 d37044 tone d48 delms     \ f=690Hz duration=48msec
d30 d37044 tone d360 delms    \ f=690Hz duration=360msec

d25 d52076 tone d50 delms     \ f=970Hz duration=50msec
d30 d52076 tone d50 delms     \ f=970Hz duration=50msec
d30 d52076 tone d50 delms     \ f=970Hz duration=50msec
d30 d52076 tone d50 delms     \ f=970Hz duration=50msec

d30 d26145 tone d25 delms     \ f=487Hz duration=25msec
d30 d26145 tone d25 delms     \ f=487Hz duration=25msec
d30 d26145 tone d25 delms     \ f=487Hz duration=25msec
d30 d26145 tone d25 delms     \ f=487Hz duration=25msec
d30 d26145 tone d25 delms     \ f=487Hz duration=25msec
d30 d26145 tone d25 delms     \ f=487Hz duration=25msec
d30 d26145 tone d25 delms     \ f=487Hz duration=25msec
d30 d26145 tone d25 delms     \ f=487Hz duration=25msec
;
: sound 
buzzar pinout 
begin
     begin snd_value W@ until
     call call
     0 snd_value W! 
0 until
;

\ Display passing time
\ ( n1 -- ) n1:time(base:0.1sec)
: disp_passtime
dup                                
d100 u/ dup dup 0= 
if h20 else h30 then
+ disp_1char
d100 u* -
dup
d10 u/ dup  
h30 + disp_1char
d10 u* -
h2E  disp_1char                    \ "."
h30 + disp_1char
h73 disp_1char                     \ "s"
h65 disp_1char                     \ "e"
h63 disp_1char                     \ "c"
;

\ Game"PUSH"
\ Only pushing bottun (When pushing bottun, one dot is off)
\ Time erasing all dots is score.
\ ( -- )
: PUSH
\ initialization
0 sw_value W!
0 snd_value W!
buzzar pinout
clr_matrix
c" matrix _matrix_Charlie_asm" 0 cogx
c" sw" 1 cogx
c" sound" 2 cogx

begin
     \ StartUp 
     h80844020 matrix L! h20408480 matrix 4+ L!
     \ Wait sw-input
     begin sw_value  W@ until 0 sw_value W!
     clr_matrix
     \ countdown
     1 snd_value W!
     h33 char d1000 delms h32 char d1000 delms h31 char d1000 delms h30 char d1000 delms 
     \ Eliminate sw-input
     0 sw_value W!
     
     fill_matrix                              
     cnt COG@ 
     erase_bit
     d64 0 do
          \ Wait until sw is pushed
          begin sw_value  W@ until
          \ Reset button flag and set start flag
          0 sw_value W!                      
          d50 d107374 tone              \ f=2000Hz duration=50msec
          dup 
          \ Erase dot
          W@ seperate matrix + C!                
          2+                 
     loop
     drop
     cnt COG@ swap - 8000000 u/ 
     disp_passtime
 
     \ Eliminate sw-input
     0 sw_value W!
     fkey? swap drop
until
0 cogreset
1 cogreset
2 cogreset
;



{
\ Driver for 8x8-Matrix-LED by Charlieplexing
\ Using P0 - P7
\ Top pin for drive is P0
\ $C_treg1:loop counter
\ $C_treg2:SCR drive data
\ $C_treg3:buffer address
\ ( n1 -- )  n1:address of 8x8-Matrix buffer 
fl
build_BootOpt :rasm
__1
     mov       $C_treg1 , # 8
     mov       $C_treg2 , __scr
     mov       $C_treg3 , $C_stTOS
     
__2     
     \ Set from P0 to P7 to Hi-Z (All LEDs off)
     mov       dira , # 0
     \ Set data to 0
     mov       outa , # 0
     \ Wait to drive next SCR
     jmpret  __delayret , # __delay
     
     \ each SCR on
     mov       outa , $C_treg2
     mov       dira , # hFF
     mov       $C_treg4 , __2.5usec
	add       $C_treg4 , cnt
     waitcnt   $C_treg4 , # 0                               
     
     \ Set data
     rdbyte    $C_treg4 , $C_treg3
     neg       $C_treg5 , $C_treg4
     sub       $C_treg5 , # 1
     mov       outa , $C_treg5
     
     \ Delay 1msec
     jmpret  __delayret , # __delay
     
     shl       $C_treg2 , # 1
     add       $C_treg3 , # 1
     
     djnz      $C_treg1 , # __2
     jmp       # __1

                                                                       
__delay
          mov       $C_treg4 , __1msec
		add       $C_treg4 , cnt
          waitcnt   $C_treg4 , # 0                               
__delayret

		ret
		
\ This value must be adjust when changing SCR     
__2.5usec
     d200      
__1msec
     d80000
     
__scr
     1     
;asm _matrix_Charlie_asm

}