*  TEACH MORSE CODE
*  COPYRIGHT (C) 1976, HOWARD CUNNINGHAM, PAUL BARINA
 
*  REVISION HISTORY
*
*       10/08/76 INITIAL VERSION ADAPTED FROM 6800
*       12/01/76 REASSEMBLED REMOVING UNUSED SPACE
*                (NOTE: THIS VERSION IS UNTESTED)
 
* GLOBAL VARIABLE STORAGE
 
        ORG     0
 
NUM     RMB     1       NUMBER OF CHARACTERS IN ALPHABET
GIVE    RMB     1       RESPONSE WAIT TIME IN SEC/50
COLUMN  RMB     1       PRINT POSITIONS REMAINING
SEED    RMB     2       RANDOM NUMBER
TEMP    RMB     2       RANDOM NUMBER TEMPORARY
TEMPXY  RMB     1       TEMPORARY -X- OR -Y- STORAGE
COUNT   RMB     1       RESPONSE WAIT TIME COUNTER
 
* ASSEMBLY CONSTANTS
 
LINE    EQU     32      TERMINAL LINE LENGTH
IDLE    EQU     3*50    INITIAL WAIT TIME IN SEC/50
WPM     EQU     15      CARACTER TRANSMISSION SPEED
WRT     EQU     $72C6   TIM OUTPUT CHARACTER SUBROUTINE
RDT     EQU     $72E9   TIM READ CHARACTER SUBROUTINE
DLY1    EQU     $7320   TIM HALF BIT TIME DELAY
DLY2    EQU     $731D   TIM FULL BIT TIME DELAY
DDRA    EQU     $6E001  DATA DIRECTION REGISTER A
PRA     EQU     $6E00   PERIPHERAL REGISTER A
PRB     EQU     $6E02   PERIPHERAL REGISTER B
TIO24   EQU     $6E07   WRITE TIMER DIV 1024; INT OFF
T8      EQU     $6E05   WRITE TIMER DIV 8, INT OFF
TMRFLG  EQU     $6E05   READ TIMER INTERRUPT FLAG
INMASK  EQU     000000001       SERIAL INPUT BIT MASK
SPEAKR  EQU     %00000010       SPEAKER OUTPUT BIT MASK
CRLF    EQU     $728A TIM NEW LINE SUBROUTINE
 
* CHARACTER TABLES
 
MORSE   RMB     1
        FCB     %1101,%100011,%10011,%1011
        FCB     %111111,%101111,%100111,%1111
        FCB     %111110,%11110,%10110,%1110
        FCB     %10010,%1010,%110,%111
        FCB     %100001,%10001,%11001,%1001
        FCB     %11101,%10101,%1101,%101
        FCB     %111100,%111000,%10100,%1100
        FCB     %110000,%100000,%11000,%10000
        FCB     %1000,%100,%11,%10
        FCB     %1101010,%1110011,%1001100,%110001,%101001
 
MAXNUM  EQU     *-1-MORSE
 
ASCII   FCB     $25     PERCENT SIGN
        FCC     'Q7ZG'
        FCC     '098O'
        FCC     '1JPW'
        FCC     'LRAM'
        FCC     '6BXD'
        FCC     'YCKN'
        FCC     '23FU'
        FCC     '45VH'
        FCC     'SITE'
        FCC     '.,?-/'
 
ERROR   FCB     255
        RMB     MAXNUM
 
 
* SUBROUTINE RANDOM
*
*       TAUSWORTH GGENERATOR USING PRIMITIVE TRINOMIAL
*               X**15 + X**4 + 1
*       WITH PERIOD 2**15  1
*       RETURNS 0 < (SEEDH,SEED) < 2**15
*       ON EXIT, A EQUALS (SEED+1) (MS BYTE OF RANDOM NUMBER)
*       X IS CLEARED, Y IS PRESERVED
 
RANDOM  LDX     #17-4
        JSR     ROTA
        LDA     TEMP+1
        AND     #%00001111
        STA     TEMP+1
        JSR     XOR
        LDX     #11
        JSR     ROTA
        LDA     #0
        STA     TEMP
        LDA     TEMP+1
        AND     #%01111000
        STA     TEMP+1
        JSR     XOR
        RTS
 
* SUBROUTINE ROTA
*
*       RETURNS TEMP = ROTATE(SEED) X TIMES
 
ROTA    LDA     SEED
        STA     TEMP
        LDA     SEED+1
        STA     TEMP+1
ROTA1   ROL     TEMP
        ROL     TEMP+1
        DEX
        BNE     ROTA1
        RTS
 
 
* SUBROUTINE XOR
*
*       RETURNS SEED = TEMP XOR SEED
 
XOR     LDA     SEED
        EOR     TEMP
        STA     SEED
        LDA     SEED+1
        EOR     TEMP+1
        STA     SEED+1
        RTS
 
 
* SUBROUTINES RETURN AND PRINT
*
*       OUTPUT CR/LF OR CHARACTER FROM A.  GENERATE LOCAL
*       CR/LF WHEN REQUIRED.  ON EXIT X AND Y ARE PRESERVED.
*       PRINT CLEARS A, RETURN SAVES A.
 
PRINT   STX     TEMPXY
        JSR     WRT
PRINT1  DEC     COLUMN
        BEQ     RETUR1
        LDX     TEMPXY
        RTS
 
RETURN  STX     TEMPXY
RETUR1  PHA
        JSR     CRLF
        LDA     #LINE
        STA     COLUMN
        PLA
        LDX     TEMPXY
        RTS
 
 
* SUBROUTINE WEIGHT
*
*       COMPUTES A WEIGHTED MOVING AVERAGE AS FOLLOWS:
*               A = .125*A + .875*Y
*       ON EXIT X AND Y ARE PRESERVED.
 
WEIGHT  STY     TEMPXY
        CLC
        ADC     TEMPXY
        JSR     RORA    (A+Y)/2
        CLC
        ADC     TEMPXY  ((A+Y)/2+Y)/2
        JSR     RORA
        CLC
        ADC     TEMPXY  (((A+Y)/2+Y)/2+Y)/2
RORA    ROL
        ROL
        ROL
        ROL
        ROL
        ROL
        ROL
        ROL
        RTS
 
 
* SUBROUTINE GRADE
*
*       THE INDIVIDUAL AND TOTAL ERROR RATES ARE
*       COMPUTED.  THE SIZE OF THE ALPHABET IS INCREASED IF
*       PERFORMANCE IS ADEQUATE.  ON ENTRY X IS CHARACTER POINTER,
*       A IS 0 FOR CORRECT RESPONSE, 255 FOR INCORRECT OR NO
*       RESPONSE.  ON EXIT A, X AND Y ARE DESTROYED.
 
GRADE   PHA
        LDY     ERROR,X
        JSR     WEIGHT  ADJUST INDIVIDUAL
        STA     ERROR,X ERROR RATE
        PLA
        LDY     ERROR
        JSR     WEIGHT  ADJUST TOTAL ERROR RATE
        STA     ERROR
        CMP     #256*30/100+1
        BCS     GRA3    IF BAD AVERAGE
        LDX     NUM
        LDA     #256*40/100-1
GRA1    CMP     ERROR,X CHECK INDIVID ERROR RATES
        BCC     GRA3    IF ANY ONE BELOW STANDARD
        DEX
        BNE     GRA1
        LDA     #MAXNUM ADD NEW LETTER IF POSSIBLE
        CMP     NUM
        BEQ     GRA3
        INC     NUM
GRA3    RTS
 
 
* SUBROUTINE SELECT
*
*       ON EXIT X CONTAINS A CHARACTER POINTER SELECTED
*       WITH PROBABILITIES PROPORTIONAL TO THEIR RESPECTIVE
*       ERROR RATES.  ON EXIT A IS DESTROYED, Y IS PRESERVED.
 
SELECT  JSR     RANDOM
        STA     TEMP+1  STORE MS BYTE
        LDA     SEED    GET LS BYTE
SEL1    LDX     NUM
SEL2    SEC             CLEAR BORROW
        SBC     ERROR,X DECREMENT BY ERROR PROB
        BCS     SEL3    IF NO BORROW
        DEC     TEMP+1  PROPAGATE BORROW TO MS BYTE
        BMI     SEL4    IF RAN NUM HAS COUNTED PAST ZERO
SEL3    DEX
        BNE     SEL2
        BEQ     SEL1
SEL4    RTS
 
 
* SUBROUTINE GRAPH
*
*       THE PREDICTOR FUNCTION IS DISPLAYED.
*       ON EXIT A, X AND Y ARE DESTROYED.
 
GRAPH   LDX     NUM
        INX
GPH1    JSR     RETURN
        LDA     ASCII-1,X       CURRENT CHARACTER
        JSR     PRINT
        LDA     #$20    SPACE
        LDY     ERROR-1,X
GPH2    JSR     PRINT   PRINT BAR GRAPH
        TYA
        SEC             CLEAR BORROW
        SBC     #255/LINE+1
        TAY
        LDA     #'*'
        BCS     GPH2    IF STILL POSITIVE
        DEX
        BNE     GPH1    IF MORE BARS TO GO
        JSR     RDT     WAIT FOR CONTINUE
        JMP     RETURN  COMMAND
 
 
* MAIN PROGRAM TEACH
*
*       ENTER FROM TIM MONITOR PROGRAM
*       STACK POINTER IS NOT INITIALIZED.
*       INTERRUPTS ARE NOT USED.
*       SEED OR SEED+1 MUST BE NONZERO.
 
TEACH   LDA     #%00000010      SET OUTPUT BIT
        STA     DDRA    DATA DIRECTION REG A
PRESET  LDX     #MAXNUM+1       INITIALIZE ERROR RATES
        LDA     #255    TO MAXIMUM
PRE1    STA     ERROR-1,X
        DEX
        BNE     PRE1
        LDX     #4      INITIAL ALPHABET SIZE
        STX     NUM
        LDA     #IDLE   INITIAL WAIT TIME
        STA     GIVE
TEA0    JSR     GRAPH   PRINT HISTOGRAM
TEA1    LDA     #0      CLEAR ERROR FLAG
        PHA
        JSR     SELECT  SELECT NEW CHARACTER
TEA6    LDA     #0      RESET TIME COUNTER
        STA     COUNT
        JSR     SEND    XMIT MORSE CODE
TEA2    LDA     #20     START 20 MSEC TIMER
        STA     TIO24
TEA3    LDA     INMASK  TEST FOR START BIT
        BIT     PRB     PERIPHERAL REGISTER B
        BEQ     TEA7    IF NO RESPONSE YET
        STX     TEMPXY  READ TERMINAL
        JSR     RDTSUP
        LDX     TEMPXY
        CMP     #$D     CHARRIAGE RETURN
        BEQ     TEA0    IF SO, PRINT HISTOGRAM
        CMP     ASCII,X
        BNE     TEA8    IF WRONG GUESS
        BEQ     TEA4    CORRECT RESPONSE
TEA7    LDA     TMRFLG  CHECK TIMER
        BPL     TEA3    IF 20 MSEC NOT UP
TEA8    INC     COUNT
        LDA     GIVE
        CMP     COUNT
        BNE     TEA2    IF TIME LEFT
        PLA             SET ERROR FLAG
        LDA     #255
        PHA
TEA4    PHA
        LDY     GIVE    COMPUTE NEW SPEED
        LDA     COUNT
        ASLA            MULTIPLY BY TWO
        BCC     TEA5
        LDA     #255    SET TO MAX ON OVERFLOW
TEA5    JSR     WEIGHT  ADJUST SPEED
        STA     GIVE
        LDA     ASCII,X PRINT ANSWER
        JSR     PRINT
        LDA     #$20    DOUBLE SPACE
        JSR     PRINT
        LDA     #250    1/4 SECOND
        JSR     PAUSE
        PLA
        CMP     ASCII,X
        BNE     TEA6    SEND LETER AGAIN IF ERROR
        PLA             GET ERROR FLAG
        JSR     GRADE   EVALUATE PERFORMANCE
        JMP     TEA1
 
 
* SUBROUTINE DIT
*
*       SEND A DIT OT OUTPUT PORT AT 1 KHZ.
*       ON EXIT X IS PRESERVED, Y IS CLEARED AND A IS
*       DESTROYED.
 
DIT     LDY     #1200/WPM*2     TWICE DIT TIME
DIT1    LDA     #SPEAKR TOGLE OUTPUT BIT
        EOR     PRA
        STA     PRA
        LDA     #500/8  HALF CYCLE PAUSE 500 USEC
        STA     T8
        JSR     PAU1    WAIT FOR TIMER FLAG
        DEY     DEC NUMBER OF HALF CYCLES
        BNE     DIT1
        RTS
 
* SUBROUTINE SEND
*
*       THE CHARACTER REFERENCED BY X IS TRANSMITTED
*       AS MORSE CODE.  ON EXIT, Y AND A ARE CLEARED
*       X IS PRESERVED.
 
SEND    LDA     MORSE,X GET MORSE BIT PATTERN
        LSRA
SEN1    PHA
        BCC     SEN2
        JSR     DIT
        JSR     DIT
SEN2    JSR     DIT
        LDA     #1200/WPM INTER-ELEMENT SPACE
        JSR     PAUSE
        PLA
        LSRA
        BNE     SEN1    LOOP UNTIL STOP BIT
        RTS
 
 
* SUBROUTINE PAUSE
*
*       WAIT A * 1024 MICROSECONDS AND RETURN.
*       ASSUMES ONE MEGAHERTZ CLOCK FREQUENCY.
*       ON EXIT A IS DESTROYED, X AND Y ARE PRESERVED.
 
PAUSE   STA     TIO24   WRITE TIMER
PAU1    LDA     TMRFLG  CHECK TIMER FLAG
        BPL     PAU1    IF NOT DONE
        RTS
 
 
* SUBROUTINE RDTSUP
*
*       GET CHARACTER FROM TERMINAL INTO A.
*       SAME AS TIM RDT SUBROUTINE, BUT WITHOUT ECHO BACK
*       TO TERMINAL AND ASSUMES START BIT PRESENT ON ENTRY.
*       X IS CLEARED, Y IS DESTROYED.
 
RDTSUP  LDX     #8
        JSR     DLY1    DELAY HALF BIT TIME
RDT2S   JSR     DLY2    DELAY FULL BIT TIME
        LDA     PRB     GET BIT
        LSRA            SHIFT INTO CARRY
        PHP
        TYA             -Y- CONTAINS CHARACTER
        LSRA            SHIFT IN A '0'
        PLP             RECALL BIT
        BCC     RDT4S
        ORA     #%10000000      CHANGE TO A '1'
RDT4S   TAY
        DEX
        BNE     RDT2S   LOOP FOR 8 BITS
        EOR     #$FF    COMPLEMENT DATA
        AND     #$7F    CLEAR PARITY
        JSR     DLY2    PAUSE FOR STOP BITS
        JMP     DLY2    AND RETURN
 
 
        END
        MON
