( testprogramma voor MAIS CAMEL-forth ) ( 13-7-2003 Frans van der Markt ) HEX BF00 CONSTANT via_orb ( bit 3 = WTCHDG, bit 6 = SBRQ ) BF01 CONSTANT via_ora ( laagste 4 bits lezen switch uit ) BF02 CONSTANT via_ddrb BF03 CONSTANT via_ddra BF04 CONSTANT via_t1cl BF05 CONSTANT via_t1ch BF06 CONSTANT via_t1ll BF07 CONSTANT via_t1lh BF08 CONSTANT via_t2cl BF09 CONSTANT via_t2ch BF0A CONSTANT via_sr ( stuurt hex display aan ) BF0B CONSTANT via_acr BF0C CONSTANT via_pcr BF0D CONSTANT via_ifr BF0E CONSTANT via_ier BF0F CONSTANT via_oranh : INIT_VIA ( initialize the VIA , overgenomen uit MAIS ) 58 via_acr C! 00 via_pcr C! 82 via_t1cl C! 06 via_t1ch C! 5F via_ddrb C! 00 via_orb C! 18 via_orb C! via_ier C@ 40 OR via_ier C! ; VARIABLE SWTABLE ( VERTAALT UITLEZING NAAR SWITCHPOSITIE ) 0 C, 2 C, 8 C, A C, 1 C, 3 C, 9 C, B C, 4 C, 6 C, C C, E C, 5 C, 7 C, D C, F C, ( 7-segments displaycodes: ) ( 1 ) ( ------- ) ( 2 | | 4 ) ( | | ) ( ------- ) ( 8 | 40 | 20 ) ( | | ) ( ------- ) ( 10 ) ( add the values to get the hex code for the character ) HEX VARIABLE HDTABLE ( hex display codes ) 10 HDTABLE ! ( 16 lang ) 3F C, 0A C, 5D C, 75 C, 66 C, 73 C, 7B C, 25 C, ( code 0 tot 7 ) 7F C, 77 C, 6F C, 7A C, 1B C, 7C C, 5B C, 4B C, ( code 8 tot F ) VARIABLE FRTABLE ( woord "6809-Forth" ) 0A FRTABLE ! ( 10 lang ) 7B C, 7F C, 3F C, 77 C, 40 C, 4B C, 78 C, 48 C, 5A C, 6A C, VARIABLE CHARTABLE ( LETTERS A-Z) 1A CHARTABLE ! 7D C, 7A C, 58 C, 7C C, 5B C, 4B C, 75 C, 6A C, ( A - H ) 20 C, 34 C, 4A C, 1A C, 68 C, 2F C, 78 C, 4F C, ( I - P ) 67 C, 48 C, 73 C, 5A C, 38 C, 3E C, 46 C, 2E C, ( Q - X ) 4E C, 11 C, ( Y - Z ) : SLEEP ( ms --- ) 0 DO 33 1+ 1 - 1+ 1- DROP LOOP ; : SHOWHEX ( n -- ) DUP 0F AND HDTABLE 2 + + C@ DUP via_sr C! ; : READ_SWITCH ( -- ) INIT_VIA via_ora C@ 0F AND ." Switch staat op positie " SWTABLE 2 + + C@ DUP . CR SHOWHEX ; : DISPLAY_FORTH ( -- ) FRTABLE @ 0 DO FRTABLE 2 + I + C@ ( code to be displayed ) via_sr C! 1000 SLEEP LOOP 0 via_sr C! 2000 SLEEP ; : COUNT_HEX ( -- ) INIT_VIA 10 0 DO I SHOWHEX 1000 SLEEP LOOP ; : COUNT_ALFA ( -- ) INIT_VIA 1A 0 DO I CHARTABLE 2 + + C@ via_sr C! 1000 SLEEP LOOP ; : CONTINU ( -- ) INIT_VIA BEGIN DISPLAY_FORTH KEY? UNTIL ;