home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / 788.seq next >
Text File  |  1991-01-22  |  11KB  |  310 lines
  1. \ Thorn Model 788 Keypad Reader                         by Andrew McKewan
  2.  
  3. comment:
  4.  
  5. The Model 780 reader accepts ABA or EMPI cards, selected by an option
  6. switch.  The output format is Thorn 31-bit Wiegand.  Keypad digits are
  7. reported individually via a 1200 baud RS-232 output line.
  8.  
  9. comment;
  10.  
  11. \ Port Pin Assignments
  12.  
  13. PORTA 0 2CONSTANT AUX-OUT       \ Auxilliary input
  14. PORTA 1 2CONSTANT AUX-IN        \ Auxilliary output
  15. \ PORTA 2 2CONSTANT OUT0          \ Wiegand data "0" output
  16. \ PORTA 3 2CONSTANT OUT1          \ Wiegand data "1" output
  17. PORTA 4 2CONSTANT G-XLED        \ Green external led
  18. PORTA 5 2CONSTANT R-XLED        \ Red external led
  19. PORTA 6 2CONSTANT LED-CTL       \ LED control line
  20. PORTA 7 2CONSTANT TAMPER        \ Tamper switch
  21.  
  22. PORTB 0 2CONSTANT PROMCS        \ EEPROM chip select
  23. PORTB 1 2CONSTANT PROMSK        \ EEPROM serial clock
  24. PORTB 2 2CONSTANT PROMDI        \ EEPROM data in
  25. PORTB 3 2CONSTANT PROMDO        \ EEPROM data out
  26. PORTB 4 2CONSTANT BUZZER        \ Buzzer control
  27. PORTB 5 2CONSTANT G-LED         \ Green led control
  28. PORTB 6 2CONSTANT Y-LED         \ Yellow led control
  29. PORTB 7 2CONSTANT R-LED         \ Red led control
  30.  
  31. PORTD 2 2CONSTANT OPTION-A      \ Option switch A
  32. PORTD 3 2CONSTANT OPTION-B      \ Option switch B
  33. PORTD 4 2CONSTANT OPTION-C      \ Option switch C
  34. PORTD 5 2CONSTANT OPTION-D      \ Option switch D
  35.  
  36. $50 CONSTANT RAM        \ start of ram
  37.  
  38. TEMP DROP  ( allocate it now )
  39.  
  40.  
  41. \ ***************************************************************************
  42. \ LED Control
  43.  
  44. CODE DARK     R-LED BSET,  Y-LED BSET,  G-LED BSET,  RTS,  END-CODE
  45. CODE RED      R-LED BCLR,  Y-LED BSET,  G-LED BSET,  RTS,  END-CODE
  46. CODE YELLOW   R-LED BSET,  Y-LED BCLR,  G-LED BSET,  RTS,  END-CODE
  47. CODE GREEN    R-LED BSET,  Y-LED BSET,  G-LED BCLR,  RTS,  END-CODE
  48.  
  49. : FLASH         ( -- )                  \ flash led green then dark.
  50.                 GREEN 500MS  DARK 500MS ;
  51.  
  52. \ ***************************************************************************
  53. \ Buzzer
  54.  
  55. MACRO BUZZER-ON    BUZZER BCLR,  END-MACRO
  56. MACRO BUZZER-OFF   BUZZER BSET,  END-MACRO
  57.  
  58. : (BEEP)        ( duration -- )
  59.                 BUZZER-ON  MS  BUZZER-OFF ;
  60.  
  61. : BEEP          30 (BEEP) ;
  62.  
  63.  
  64. \ **************************************************************************
  65. \ Scan keypad
  66. \ *** NOT READY FOR LIBRARY ***
  67.  
  68. 40 CONSTANT DEBOUNCE  ( units of 512 uS )
  69.  
  70. VARIABLE FLAGS
  71. FLAGS 0 2CONSTANT KEYFLG        \ set when key detected
  72.  
  73. LABEL SCANCODE
  74. ( 0-5       )  $09 C,  $06 C,  $03 C,  $12 C,  $44 C,  $41 C,
  75. ( 6-9, *, # )  $50 C,  $24 C,  $21 C,  $30 C,  $0C C,  $18 C,   END-CODE
  76.  
  77. LABEL KEYDN     ( set Z flag if no key is down )
  78.                 PORTC LDA,  A COM,  $7F # AND,  RTS,  END-CODE
  79.  
  80. LABEL SCAN      ( carry set if key down, key in X )
  81.                 KEYDN JSR,  0= NOT
  82.                 IF,     11 # LDX,  ( 9 if numeric only )
  83.                         BEGIN,  SCANCODE ,X CMP,  0= IF,  SEC,  RTS,  THEN,
  84.                                 X DEC,  0<
  85.                         UNTIL,
  86.                 THEN,  CLC,  RTS,  END-CODE
  87.  
  88. LABEL KEYUP     \ Clear KEYFLG if key is released and debounced.  Otherwise
  89.                 \ just return.
  90.                 KEYDN JSR,  0=
  91.                 IF,     CARH LDA,  CARL TST,  TEMP 1+ STA,
  92.                         BEGIN,  KEYDN JSR,  0=
  93.                         WHILE,  CARH LDA,  CARL TST,  TEMP 1+ SUB,
  94.                                 DEBOUNCE # CMP,  < NOT
  95.                         UNTIL,  KEYFLG BCLR,  THEN,
  96.                 THEN,   RTS,  END-CODE
  97.  
  98. CODE ?KEY       ( -- key true | false )
  99.                 \ Check keypad.  If a key is down, return the key value
  100.                 \ and a true flag.  If no key is down, return a false flag.
  101.                 \ If KEYFLG is set, then we just returned a key and we
  102.                 \ must wait for it to be released.
  103.                 TEMP STX,
  104.                 KEYFLG SET IF,  KEYUP JSR,  2 $ BRA,  THEN,
  105.                 SCAN JSR,  2 $ BCC,
  106.         1 $:    TEMP 1+ STX,  ( key )
  107.                 CARH LDA,  CARL TST,  TEMP 2+ STA,  ( timer )
  108.                 BEGIN,  SCAN JSR,  2 $ BCC,
  109.                         TEMP 1+ CPX,  1 $ BNE,
  110.                         CARH LDA,  CARL TST,  TEMP 2+ SUB,
  111.                         DEBOUNCE # CMP,  < NOT
  112.                 UNTIL,
  113.                 KEYFLG BSET,  ( got a key )
  114.                 TXA,  TEMP LDX,  PUSH,
  115.                 TRUE # LDA,  PUSH,
  116.                 RTS,
  117.  
  118.         2 $:    TEMP LDX,  A CLR,  PUSH,  RTS,  ( no key )
  119.                 END-CODE
  120.  
  121.  
  122. \ ***************************************************************************
  123. \ SCI transmit for keypad data
  124.  
  125. : SCI-INIT      ( -- )
  126.                 $00 SCCR1 !     \ 8 data bits, 1 stop bit
  127.                 $08 SCCR2 !     \ enable transmitter, no SCI interrputs
  128.                 $33 BAUD !  ;   \ 1200 baud
  129.  
  130. CODE EMIT       ( char -- )     \ send byte to sci port
  131.                 BEGIN,  TDRE SET  UNTIL,
  132.                 POP,  SCDAT STA,
  133.                 RTS,                            END-CODE
  134.  
  135. CODE KEY        ( -- char )     \ get byte from sci port (not used here)
  136.                 BEGIN,  RDRF SET  UNTIL,
  137.                 SCDAT LDA,  PUSH,
  138.                 RTS,                            END-CODE
  139.  
  140. \ ***************************************************************************
  141. \ Keypad
  142.  
  143. LABEL KEYCODES
  144.                 $F7 C, $F0 C, $F4 C, $F8 C, $F1 C, $F5 C,
  145.                 $F9 C, $F2 C, $F6 C, $FA C, $F3 C, $FB C,
  146.                 END-CODE
  147.  
  148. CODE KEYCODE    ( key# -- code )
  149.                 TEMP STX,
  150.                 0 ,X LDX,  KEYCODES ,X LDA,
  151.                 TEMP LDX,  0 ,X STA,
  152.                 RTS,  END-CODE
  153.  
  154. : DO-KEY        ( key -- )
  155.                 BEEP
  156. \ SEND-KEY ( wiegand key output for testing )
  157.                 KEYCODE EMIT    \ send to SCI port
  158.                 ;
  159.  
  160. \ ***************************************************************************
  161. \ LED Control
  162.  
  163. comment:
  164.         LED-CTL       AUX-IN          LED
  165.  
  166.            1             1             RED
  167.            0             1             GREEN
  168.            1             0             YELLOW
  169.            0             0             YELLOW
  170.  
  171.         LED-CTL = PORTA 6
  172.         AUX-IN  = PORTA 1
  173. comment;
  174.  
  175. : DO-LED        ( -- )
  176.                 PORTA @ $02 AND 0= IF YELLOW EXIT THEN
  177.                 PORTA @ $40 AND    IF RED    EXIT THEN
  178.                 GREEN ;
  179.  
  180. \ ***************************************************************************
  181. \ ABA Card Processing
  182. \
  183. \ The reader accepts 12-digit ABA cards.  The first six digits are converted
  184. \ to binary and stored as the site code.  The next six digits are the ID
  185. \ number.  If the site code overflows 8 bits or the ID overflows 16 bits then
  186. \ they are set to the maximum value (255 and 65535).
  187.  
  188. 2 array buf             \ buffer for binary conversion
  189. variable overflow       \ set if result overflows 16 bits
  190.  
  191. code *10        ( -- )          \ multiply buf * 10
  192.                 temp stx,
  193.                 buf 1 + lda,  10 # ldx,  mul,
  194.                 buf 1 + sta,  temp 1+ stx,
  195.                 buf lda,  10 # ldx,  mul,  x tst,  1 $ bne,
  196.                 temp 1 + add,  buf sta,  2 $ bcc,
  197.         1 $:    overflow 0 bset,
  198.         2 $:    temp ldx,  rts,         end-code
  199.  
  200. code add        ( n -- )        \ add n to buf
  201.                 pop,
  202.                 buf 1 + add,  buf 1 + sta,
  203.                 buf lda,  0 # adc,  buf sta,  1 $ bcc,
  204.                 overflow 0 bset,
  205.         1 $:    rts,  end-code
  206.  
  207. : conv          ( n -- )  \ convert n digits to binary in buf
  208.                 overflow off
  209.                 buf 2 erase
  210.                 ( n ) for  *10  digit add  next ;
  211.  
  212. : conv-site     ( -- )          \ convert 6 digits of card to site
  213.                 6 conv
  214.                 overflow @  buf @ or
  215.                 if  255  ( overflow )  else  buf 1 + @  then
  216.                 data 1 + ! ;
  217.  
  218. : conv-id       ( -- )          \ convert 6 digits of card to id
  219.                 6 conv
  220.                 overflow @
  221.                 if  255 dup ( overflow )  else  buf 2@  then
  222.                 data 2 + 2! ;
  223.  
  224. : convert       ( -- )          \ convert 12-digit ABA to binary
  225.                 rewind margin
  226.                 digit drop  ( soc )
  227.                 conv-site
  228.                 conv-id ;
  229.  
  230. : do-ABA        ( -- )          \ check card data.  If valid send in
  231.                                 \ Thorn 31-bit Wiegand format.
  232.                 valid-aba
  233.                 #digits @ 15 = and  ( 12 data digits on card )
  234.                 if      convert
  235.                         send-thorn-31bits
  236.                 then ;
  237.  
  238. \ ***************************************************************************
  239. \ EMPI Card Processing
  240. \
  241. \ Valid Thorn job codes are from 2000 to 2255.  We add $30 to the job code
  242. \ to bring it into the range $0800 to $08FF.  Then we check the high byte
  243. \ and make sure it is 8.  The site code to transmit is in the low byte.
  244. \ An invalid job code is reported as site code 255.
  245.  
  246. code bias       ( -- )          \ ad $30 to job code
  247.                 data 1+ lda,  $30 # add,  data 1+ sta,
  248.                 data lda,  0 # adc,  data sta,  rts,  end-code
  249.  
  250. : job-ok        ( -- f )        \ return true if thorn job code
  251.                 data @ 8 = ;
  252.  
  253. : test  \ not in production code
  254.         portd @ 8 and 0= ( option b on )
  255.         if      #bits @ 10 >
  256.                 if      send-all
  257.                 then
  258.         then ;
  259.  
  260. : do-EMPI       ( -- )          \ check for valid EMPI data with correct
  261.                                 \ job code.  If valid send card in Thorn
  262.                                 \ 31-bit Wiegand format.
  263.                 valid-empi
  264.                 if      bias
  265.                         job-ok not if  255 data 1 + !  then
  266.                         send-thorn-31bits
  267.                 then    ;
  268.  
  269. : do-card       ( -- )
  270.                 portd @ 4 and ( option-a off )
  271.                 if      do-EMPI
  272.                 else    do-ABA
  273.                 then ;
  274.  
  275.  
  276. : READER        ( -- )
  277.                 CLEAR-CARD ENABLE
  278.                 BEGIN   DO-LED
  279.                         ?KEY IF  DISABLE  DO-KEY  EXIT  THEN
  280.                         CARD-EVENT
  281.                 UNTIL
  282.                 CARD-DONE
  283.                 DO-CARD ;
  284.  
  285. : MAIN
  286.                 $01 PORTA !     $0D DDRA !
  287.                 $F0 PORTB !     $F7 DDRB !
  288.                 $00 PORTC !     $00 DDRC !
  289.                 STACK 4 $EE FILL        \ for stack trace
  290.                 5 SKIP0 !               \ card lead-in
  291.                 10 OUTPUT !             \ Wiegand 1 ms bit time
  292.  
  293.                 SCI-INIT ( init serial port )
  294.  
  295.                 4 FOR  FLASH  NEXT      \ I'm ok
  296.  
  297.                 BEGIN  READER  AGAIN ;
  298.  
  299. \ ***************************************************************************
  300. \ Interrupt Vector Initialization
  301.  
  302.         $100    $1FF4 !-T          \ SPI transfer complete
  303.         $100    $1FF6 !-T          \ SCI serial
  304.         EDGE    $1FF8 !-T          \ Timer
  305.         $100    $1FFA !-T          \ External IRQ
  306.         $100    $1FFC !-T          \ SWI
  307.         $100    $1FFE !-T          \ Reset
  308.  
  309.  
  310.