\ require spi-base-avr.txt 
\ Words to drive the SPI module on the ATmega328P 
\ PJ 31-Jan-2016 
\ adapted for ARDUINO MEGA and commented by M. PETREMANN 16 jun 2019 
-8x8 
marker -8x8 
 
\ Registers of interest 
$24 constant DDRB 
$25 constant PORTB 
$4c constant SPCR 
$4d constant SPSR 
$4e constant SPDR 
 
\ bit masks for ARDUINO MEGA 
%00000001 constant mSS    ( PB0 ) 
%00000010 constant mSCK   ( PB1 ) 
%00000100 constant mMOSI  ( PB2 ) 
%00001000 constant mMISO  ( PB3 ) 
$80 constant mSPIF 
$40 constant mWCOL 
 
\ !SS is on PB0 
: spi.select ( -- )             \ select slave 1 in mSS constant  
    mSS PORTB mclr ; 
: spi.deselect ( -- )           \ unselect slave  
    mSS PORTB mset ; 
 
: spi.init ( -- )  
    mSCK DDRB mset              \ SCK as output 
    mSCK PORTB mclr             \ clock idles low 
    mMOSI DDRB mset             \ MOSI as output 
    mMISO DDRB mclr             \ MISO as input 
    mMISO PORTB mset            \ activate pull-up on MISO 
    mSS DDRB mset               \ SS as output 
    mSS PORTB mset              \ deselect 
    $51 SPCR c!     \ enable as master with cpolarity 0, cphase 0, fosc/16 
    $00 SPSR c!     \ SPI2X=0 for fosc/16 
    SPSR c@ drop SPDR c@ drop   \ will clear SPIF 
; 
: spi.close ( -- ) 
    $00 SPCR c! 
; 
: spi.wait ( -- )  
    begin  
        mSPIF SPSR mtst  
    until ; 
\ The key word spi.cexch starts the exchange of a byte by writing it  
\ to the SPI data buffer. 
: spi.cexch ( c1 -- c2 )  
    SPDR c! spi.wait SPDR c@ ; 
: spi.csend ( c1 -- )  
    spi.cexch drop ; 
 
: spi.test ( -- )  
  spi.init 
  spi.select 
  $1c spi.csend \ an arbitrary byte 
  spi.deselect 
  spi.close 
; 
 
\ original led-matrix-display.txt 
\ Drive a MAX7219 display chip with 8x8 LED matrix 
 
 
\ c1 = 
\ c2 =  
: max7219.send ( c1 c2 -- ) 
    swap  
    spi.select  
    spi.csend  
    spi.csend  
    spi.deselect 
; 
 
: disp.normal ( -- )  
    $0c $01 max7219.send ; 
: disp.shutdown ( -- )  
    $0c $00 max7219.send ; 
 
: disp.test.on ( -- )  
    $0f $01 max7219.send ; 
: disp.test.off ( -- )  
    $0f $00 max7219.send ; 
 
: disp.no.op ( -- )  
    $00 $00 max7219.send ; 
: disp.intensity ( c -- )  
    $0a swap max7219.send ; 
: disp.decode ( c -- )  
    $09 swap max7219.send ; 
: disp.scan.limit ( c -- )  
    $0b swap max7219.send ; 
: disp.set.digit ( cbits cdigit -- )  
    swap max7219.send ; 
 
\ ****** TEST section ********************************* 
: disp-test-1 ( -- ) \ all LEDs on full, 232mA needed 
    spi.init 
    disp.test.on 
    begin key? until 
    disp.test.off 
    spi.close 
; 
: disp-test-2 ( -- ) \ left 4 LEDs on first row, 42mA needed 
    spi.init 
    disp.normal 
    $03 disp.intensity 
    $00 disp.scan.limit 
    $f0 $01 disp.set.digit 
    begin key? until 
    disp.shutdown 
    spi.close 
; 
: disp-test-3 ( -- ) \ draw face, 18mA needed 
    spi.init 
    disp.normal 
    $01 disp.intensity 
    $07 disp.scan.limit 
    %00000000 $01 disp.set.digit 
    %01100110 $02 disp.set.digit 
    %00000000 $03 disp.set.digit 
    %00011000 $04 disp.set.digit 
    %00011000 $05 disp.set.digit 
    %10000001 $06 disp.set.digit 
    %01000010 $07 disp.set.digit 
    %00111100 $08 disp.set.digit 
    begin key? until 
    disp.shutdown 
    spi.close 
; 
 
flash 
create SMILEY ( --- addr) 
    %00100000 c, 
    %01000010 c, 
    %10000010 c, 
    %10011000 c, 
    %10011000 c, 
    %10000010 c, 
    %01000010 c, 
    %00100000 c, 
 
: disp.char ( addr ---) 
    1-                  \ decrement array address 
    8 for    
        1+ dup c@       \ increment address, duplicate and get value 
        8 r@ -          \ get loop index, numbering 1 to 8 
        swap max7219.send 
        \ cr . . 
    next  
    drop                \ drop array address 
    ; 
 
: smiley-disp ( ---) 
    spi.init 
    disp.normal 
    $01 disp.intensity 
    $07 disp.scan.limit 
    SMILEY disp.char 
    begin key? until 
    disp.shutdown 
    spi.close 
; 
 
flash 
create SMILEYsprite ( --- addr) 
    %00000000 c, 
    %00000000 c, 
    %00000000 c, 
    %00000000 c, 
    %00000000 c, 
    %00000000 c, 
    %00000000 c, 
    %00000000 c, 
    %00100000 c, 
    %01000010 c, 
    %10000010 c, 
    %10011000 c, 
    %10011000 c, 
    %10000010 c, 
    %01000010 c, 
    %00100000 c, 
    %00000000 c, 
    %00000000 c, 
    %00000000 c, 
    %00000000 c, 
    %00000000 c, 
    %00000000 c, 
    %00000000 c, 
    %00000000 c, 
 
: sprite-scroll ( addr ---) 
    1-                  \ decrement array address 
    16 for    
        1+ dup          \ increment address, duplicate and get value 
        disp.char 
        200 ms 
    next  
    drop                \ drop array address 
; 
 
: disp-scroll ( ---) 
    spi.init 
    disp.normal 
    $01 disp.intensity 
    $07 disp.scan.limit 
    begin  
        SMILEYsprite sprite-scroll 
    key? until 
    disp.shutdown 
    spi.close 
; 
 
\ *** Array with alphanumerics characters *** 
 
\ caracters ..0..9A..Z in array 
flash 
create CHARACTERS 
    $00 c, $00 c, $00 c, $00 c,  
    $00 c, $00 c, $00 c, $00 c,     \  U+0020 (space) 
    $00 c, $00 c, $00 c, $00 c, 
    $bf c, $00 c, $00 c, $00 c,     \  U+0021 (!) 
    $00 c, $00 c, $03 c, $00 c,  
    $03 c, $00 c, $00 c, $00 c,     \  U+0022 (") 
    $00 c, $24 c, $ff c, $24 c,  
    $24 c, $ff c, $24 c, $00 c,     \  U+0023 (#) 
    $00 c, $24 c, $4a c, $cb c,      
    $4a c, $4a c, $30 c, $00 c,     \  U+0024 ($) 
    $00 c, $42 c, $25 c, $12 c,  
    $48 c, $a4 c, $42 c, $00 c,     \  U+0025 (%) 
    $00 c, $66 c, $99 c, $91 c,  
    $a1 c, $41 c, $b2 c, $00 c,     \  U+0026 (&) 
    $00 c, $00 c, $00 c, $03 c,  
    $00 c, $00 c, $00 c, $00 c,     \  U+0027 (') 
    $00 c, $00 c, $00 c, $7e c,  
    $81 c, $00 c, $00 c, $00 c,     \  U+0028 (() 
    $00 c, $00 c, $00 c, $81 c,  
    $7e c, $00 c, $00 c, $00 c,     \  U+0029 ()) 
    $00 c, $00 c, $54 c, $38 c,  
    $fe c, $38 c, $54 c, $00 c,     \  U+002a (*) 
    $00 c, $08 c, $08 c, $08 c,  
    $7f c, $08 c, $08 c, $08 c,     \  U+002b (+) 
    $00 c, $00 c, $00 c, $00 c,  
    $80 c, $60 c, $00 c, $00 c,     \  U+002c (,) 
    $00 c, $10 c, $10 c, $10 c,  
    $10 c, $10 c, $10 c, $00 c,     \  U+002d (-) 
    $00 c, $00 c, $00 c, $00 c,  
    $c0 c, $c0 c, $00 c, $00 c,     \  U+002e (.) 
    $00 c, $40 c, $20 c, $10 c,  
    $08 c, $04 c, $02 c, $00 c,     \  U+002f (/) 
    $00 c, $7e c, $a1 c, $91 c,  
    $89 c, $85 c, $7e c, $00 c,     \  U+0030 (0) 
    $00 c, $00 c, $00 c, $04 c,  
    $82 c, $ff c, $80 c, $00 c,     \  U+0031 (1) 
    $00 c, $e2 c, $91 c, $91 c,  
    $91 c, $91 c, $8e c, $00 c,     \  U+0032 (2) 
    $00 c, $42 c, $81 c, $89 c,  
    $89 c, $89 c, $76 c, $00 c,     \  U+0033 (3) 
    $00 c, $0f c, $08 c, $08 c,  
    $08 c, $08 c, $ff c, $00 c,     \  U+0034 (4) 
    $00 c, $87 c, $89 c, $89 c,  
    $89 c, $89 c, $71 c, $00 c,     \  U+0035 (5) 
    $00 c, $7e c, $89 c, $89 c,  
    $89 c, $89 c, $72 c, $00 c,     \  U+0036 (6) 
    $00 c, $00 c, $01 c, $01 c,  
    $01 c, $f1 c, $0f c, $00 c,     \  U+0037 (7) 
    $00 c, $76 c, $89 c, $89 c,  
    $89 c, $89 c, $76 c, $00 c,     \  U+0038 (8) 
    $00 c, $46 c, $89 c, $89 c,  
    $89 c, $89 c, $7e c, $00 c,     \  U+0039 (9) 
    $00 c, $00 c, $00 c, $00 c,  
    $6c c, $00 c, $00 c, $00 c,     \  U+003a (:) 
    $00 c, $02 c, $04 c, $08 c,  
    $10 c, $20 c, $40 c, $00 c,     \  U+003b (\) 
    $00 c, $10 c, $28 c, $28 c,  
    $44 c, $44 c, $82 c, $00 c,     \  U+003c (<) 
    $00 c, $24 c, $24 c, $24 c,  
    $24 c, $24 c, $24 c, $00 c,     \  U+003d (=) 
    $00 c, $82 c, $44 c, $44 c,  
    $28 c, $28 c, $10 c, $00 c,     \  U+003e (>) 
    $00 c, $02 c, $01 c, $a1 c,  
    $11 c, $11 c, $0e c, $00 c,     \  U+003f (?) 
    $00 c, $7e c, $81 c, $8d c,  
    $93 c, $91 c, $4e c, $00 c,     \  U+0040 (@) 
    $00 c, $fe c, $11 c, $11 c,  
    $11 c, $11 c, $fe c, $00 c,     \  U+0041 (A) 
    $00 c, $ff c, $89 c, $89 c,  
    $89 c, $89 c, $76 c, $00 c,     \  U+0042 (B) 
    $00 c, $7e c, $81 c, $81 c,  
    $81 c, $81 c, $42 c, $00 c,     \  U+0043 (C) 
    $00 c, $ff c, $81 c, $81 c,  
    $81 c, $81 c, $7e c, $00 c,     \  U+0044 (D) 
    $00 c, $ff c, $89 c, $89 c,  
    $89 c, $89 c, $81 c, $00 c,     \  U+0045 (E) 
    $00 c, $ff c, $09 c, $09 c,  
    $09 c, $09 c, $01 c, $00 c,     \  U+0046 (F) 
    $00 c, $7e c, $81 c, $81 c,  
    $91 c, $91 c, $72 c, $00 c,     \  U+0047 (G) 
    $00 c, $ff c, $08 c, $08 c,  
    $08 c, $08 c, $ff c, $00 c,     \  U+0048 (H) 
    $00 c, $00 c, $00 c, $81 c,  
    $ff c, $81 c, $00 c, $00 c,     \  U+0049 (I) 
    $00 c, $70 c, $80 c, $80 c,  
    $81 c, $7f c, $01 c, $00 c,     \  U+004a (J) 
    $00 c, $ff c, $10 c, $18 c,  
    $24 c, $42 c, $81 c, $00 c,     \  U+004b (K) 
    $00 c, $81 c, $ff c, $81 c,  
    $80 c, $80 c, $c0 c, $00 c,     \  U+004c (L) 
    $00 c, $ff c, $02 c, $04 c,  
    $04 c, $02 c, $ff c, $00 c,     \  U+004d (M) 
    $00 c, $ff c, $02 c, $04 c,  
    $08 c, $10 c, $ff c, $00 c,     \  U+004e (N) 
    $00 c, $7e c, $81 c, $81 c,  
    $81 c, $81 c, $7e c, $00 c,     \  U+004f (O) 
    $00 c, $ff c, $11 c, $11 c,  
    $11 c, $11 c, $0e c, $00 c,     \  U+0050 (P) 
    $00 c, $7e c, $81 c, $81 c,  
    $a1 c, $c1 c, $fe c, $00 c,     \  U+0051 (Q) 
    $00 c, $ff c, $11 c, $11 c,  
    $31 c, $51 c, $8e c, $00 c,     \  U+0052 (R) 
    $00 c, $46 c, $89 c, $89 c,  
    $89 c, $89 c, $72 c, $00 c,     \  U+0053 (S) 
    $00 c, $01 c, $01 c, $ff c,  
    $01 c, $01 c, $00 c, $00 c,     \  U+0054 (T) 
    $00 c, $7f c, $80 c, $80 c,  
    $80 c, $80 c, $7f c, $00 c,     \  U+0055 (U) 
    $00 c, $3f c, $40 c, $80 c,  
    $40 c, $3f c, $00 c, $00 c,     \  U+0056 (V) 
    $00 c, $ff c, $40 c, $20 c,  
    $20 c, $40 c, $ff c, $00 c,     \  U+0057 (W) 
    $00 c, $c1 c, $22 c, $1c c,  
    $1c c, $22 c, $c1 c, $00 c,     \  U+0058 (X) 
    $00 c, $0f c, $10 c, $e0 c,  
    $10 c, $0f c, $00 c, $00 c,     \  U+0059 (Y) 
    $00 c, $c1 c, $a1 c, $91 c,  
    $89 c, $85 c, $83 c, $00 c,     \  U+005a (Z) 
 
: getChar ( n ---)          \ get nth caracters from CHARACTERS table 
    8 * CHARACTERS + 
    ; 
 
\ Only for test encoding characters 
\ : tstChar ( n ---) 
\     getChar 1- 
\     8 for 
\         1+ dup c@ 
\         0 2dup 
\         hex <# # # #> cr type ."  - " 
\         bin <# # # # # # # # # #> type 
\         decimal 
\     next  
\     drop  
\     ; 
 
: Cdisp ( n ---)            \ display character on 8x8 LED matrix 
    spi.init 
    disp.normal 
    $01 disp.intensity 
    $07 disp.scan.limit 
    getChar disp.char 
    begin key? until 
    disp.shutdown 
    spi.close 
; 
 
: Cled ( n ---)          \ typical use: char B Cled 
    32 - Cdisp ; 
 
 
-txtScroll 
marker -txtScroll 
 
: FORTH s" FORTH" ; 
 
ram create scrollBuffer 
   18 8 * allot 
 
variable inCharBuffer   \ pointer nth char 
 
: charToBuffer ( char ---) \ copy a matric char in buffer 
    32 - getChar        \ calculate start address 
    scrollBuffer inCharBuffer @ 8 * + \ calculate destination address 
    8 cmove             \ copy char matric 
    1 inCharBuffer +!   \ increment buffer storage pointer 
    ; 
 
: text-in-buffer ( adr len ---) 
    0 inCharBuffer !    \ initialise buffer storage pointer 
    32 charToBuffer     \ copy 'space' matrix in buffer 
    dup                 \ duplicate len 
    for 
        2dup            \ duplicate adr len 
        r@ 1+ - +       \ calculate adr char by char 
        c@              \ get char in input string (adr len) 
        charToBuffer    \ copy matric char in buffer 
    next 
    2drop 
    32 charToBuffer     \ copy 'space' matrix in buffer 
    ; 
 
: text-scroll ( ---) 
    scrollBuffer 1-     \ decrement scroll buffer address 
    inCharBuffer @ 1- 8 * for    
        1+ dup          \ increment address, duplicate and get value 
        disp.char 
        200 ms 
    next  
    drop                \ drop array address 
; 
 
 
 
: txt-scroll ( adr len ---)  \ example FORTH txt-scroll 
    text-in-buffer 
    spi.init 
    disp.normal 
    $01 disp.intensity 
    $07 disp.scan.limit 
    begin  
        text-scroll 
    key? until 
    disp.shutdown 
    spi.close 
;