;
 
;;;;;; Computer Case Climate Controller ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Sacreligous Design Project
;
; Erik Rainey       : All functions except those mentioned below
; Justin Dominitz   l GetTemp, HexToDecimal
; Stan Gryskiewicz  : DecrementFans, ResetFans, GetFanSpeeds
;
;
; Since this kind of code is SO specific to the PIC microcontroller and this
; hardware that I think that licensing it as some sort of open source is
; funny. If you have ideas as to what license it should have please email me
; erik@epimp.com
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

        list  P=PIC16F877, F=INHX8M, C=160, N=77, ST=OFF, MM=OFF, R=DEC, X=OFF
        #include P16F877.inc
;       __config(_CP_OFF & _PWRTE_ON & _XT_OSC & _WDT_OFF & _BODEN_OFF)
        errorlevel -302         ;Ignore "error" when storing to Bank1

;;;;;;; Equates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Bank0RAM equ    H'20'    ;Start of Bank 0 RAM area
Bank1RAM equ    H'A0'    ;Start of Bank 1 RAM area
Bank2RAM equ    H'110'   ;Start of Bank 2 RAM area
Bank3RAM equ    H'190'   ;Start of Bank 3 RAM area

CrossBankRAM equ H'70'   ;Start of Cross Bank RAM

MaxCount equ    10       ;Number of loops in half a second

MaxOuter equ    10
MaxInner equ    100

CR       equ    H'0d'
XON      equ    H'11'
XOFF     equ    H'13'

Freq     equ    4
SDA      equ    4
SCL      equ    3

MechDelayConst equ 100

;;;;;;; Variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    cblock    Bank0RAM
    BLNKCNT         ;Loop counter for blinking LEDs every half sec.
    BLINKTEMP       ;Temporary variable for BlinkTable subroutine
    INDEX           ;The value of what we want to display
    ;;;;;;;;;;;;;;;;;;;;;;;;;
    ; I2C Subroutine varables
    DATAIN
    DATAOUT
    DEVADD
    INTADD
    TXBUFF
    RXBUFF
    ;;;;;;;;;;;;;;;;;;;;;;;;;
    ; Fan Variables
    GeneralCycle

    DutyCycle0
    DutyCycle1
    DutyCycle2
    DutyCycle3
    DutyCycle4
    DutyCycle5
    DutyCycle6
    DutyCycle7

    CurrentCount0
    CurrentCount1
    CurrentCount2
    CurrentCount3
    CurrentCount4
    CurrentCount5
    CurrentCount6
    CurrentCount7
    ;;;;;;;;;;;;;;;;;;;;;;;;;
    ; Temperature Variables
    Temp0
    Temp1
    Temp2
    Temp3
    Digit0
    Digit1
    Digit2
    TempX
    ;;;;;;;;;;;;;;;;;;;;;;;;;
    ; Control Variables
    DESIREDTEMP
    DIFF0
    DIFF1
    DIFF2
    DIFF3
    ADD1
    ADD2
    ;;;;;;;;;;;;;;;;;;;;;;;;;
    ; RPG Variables
        RPGNUMBER               ;Variable controlled by RPG
        OLDRPG                  ;Old bits from RPG
        DELTARPG                ;Value of +1, 0, -1 from table for RPG change
    ;;;;;;;;;;;;;;;;;;;;;;;;;
    ; Fan Speed Variables
    FSPEED0H
    FSPEED0L
    FSPEED1H
    FSPEED1L
    FANSPEEDH
    FANSPEEDL
    ;;;;;;;;;;;;;;;;;;;;;;;;;
    ; Display Varaibles
    SCREENNUM
    ;;;;;;;;;;;;;;;;;;;;;;;;;
    endc

    cblock    Bank1RAM
    endc

    cblock    Bank2RAM
    endc

    cblock    Bank3RAM
    endc

    cblock  CrossBankRAM
    DIS_TEMP        ; temp var for Display
    TEMP            ; just a temp var
    W_TEMP          ; W save value
    STATUS_TEMP     ; STATUS save value
    TEMPNUM         ; temp for checking 0-9 status
    LOOPTIME        ; determines what loop we are on
    endc


;;;;;;; Macro definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

MOVLF       macro    literal,dest
    movlw   literal
    movwf   dest
    endm

MOVFF       macro    source,dest
    movf    source,W
    movwf   dest
    endm

NEWLINE     macro
    movlw   H'0d'
    call    TXbyte
    movlw   H'0a'
    call    TXbyte
    endm

VFDNEWLINE  macro
    movlw   _Newline-Message_Start
    call    DisplayC
    endm

_VFDSPACE   macro
    movlw   H'20'
    call    VFDbyte
    endm

_SPACE      macro
    movlw   H'20'
    call    TXbyte
    endm

SEND_XOFF   macro
    movlw   XOFF
    call    TXbyte
    endm

SEND_XON    macro
    movlw   XON
    call    TXbyte
    endm

DEGREES     macro
    movlw   H'DF'
    call    VFDbyte
    movlw   A'C'
    call    VFDbyte
    endm

BANK0       macro
    bcf     STATUS,RP0
    ;bcf     STATUS,RP1
    endm

BANK1       macro
    bsf     STATUS,RP0
    ;bcf     STATUS,RP1
    endm

BANK2       macro
    bcf     STATUS,RP0
    bsf     STATUS,RP1
    endm

BANK3       macro
    bsf     STATUS,RP0
    bsf     STATUS,RP1
    endm

TWOCOMP      macro reg
    comf     reg,F
    movlw    1
    addwf    reg,F
    endm

; this used so that the fan duty cycles never go above 100%
ADD_NOWRAP    	macro dest,source1,source2
    movf    source2,W
    addwf   source1,F
    bsf     STATUS,C
    movlw   100
    subwf   source1,W
    btfss   STATUS,C
    addlw   100
    btfsc   STATUS,C
    movlw   100
    movwf   dest
    endm

SUB1616 macro   A0,A1,B0,B1,C0,C1
; subtract A0,A1` from B0, B1 and put results in C0,C1
        movf    A1,W
        subwf   B1,W            ; low byte, carry set possibly
        movwf   C1              ; save it
        movf    A0,W            ; get high byte
        btfss   STATUS,C        ; skip if no borrow from low byte
        addlw   1               ; There was a borrow
        subwf   B0,W            ; high order difference
        movwf   C0              ; save it
        endm

SUB_NOWRAP	macro dest, source1, source2
    bsf	    STATUS,C
    movf    source2,W
    subwf   source1,W
    btfss   STATUS,C
    movlw   0
    movwf   dest
    endm

    noexpand
delay       macro freq4,freq10,freq20
    if      Freq==4
    fill    (nop),freq4
    endif
    if      Freq==10
    fill    (nop),freq10
    endif
    if      Freq==20
    fill    (nop),freq20
    endif
    endm

;;;;;;; Vectors ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    org    H'003'            ;Reset vector
    goto   Mainline    ;Branch past tables
    org    H'004'
    goto   IntService
    nop
    nop

;;;;;;;DisplayC_Table subroutine;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; This subroutine is called with VFD_TEMP containing the offset from CDS
; to the desired byte.

DisplayC_Table
    movf    DIS_TEMP,W      ;Copy VFD_TEMP to W
    addwf   PCL,F           ;add adequate offset to PCL

Message_Start
_Info1
    retlw   H'80'
    dt      "Initializing...."
    retlw   0
_Info2
    retlw   H'C0'
    dt      "C.C.C.C.  aka C4"
    retlw   0
_Desired
    retlw   H'80'
    dt      "Desired Temp:"
    retlw   0
_Newline
    retlw   H'C0'
    retlw   0
_1
    retlw   H'80'
    dt      "1:"
    retlw   0
_2
    retlw   H'88' ;Changed to 88 -Domnitz
    dt      "2:"
    retlw   0
_3
    retlw   H'C0'
    dt      "3:"
    retlw   0
_4
    retlw   H'C8' ;Changed to C8 -Domnitz
    dt      "4:"
    retlw   0
;;; Only for Terminal Usage
_Prompt
    dt      "$ "
    retlw   0

;;;;;;; RPGtable subroutine ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; This subroutine takes the two RPG outputs from ten milliseconds ago and the
; present two RPG outputs in W and returns +1, 0, or -1 on their basis

RPGtable
        addwf   PCL,F           ;Go to proper table entry
        retlw   0               ;00 -> 00
        retlw   -1              ;00 -> 01
        retlw   +1              ;00 -> 10
        retlw   0               ;00 -> 11 (don't care)
        retlw   +1              ;01 -> 00
        retlw   0               ;01 -> 01
        retlw   0               ;01 -> 10 (don't care)
        retlw   -1              ;01 -> 11
        retlw   -1              ;10 -> 00
        retlw   0               ;10 -> 01 (don't care)
        retlw   0               ;10 -> 10
        retlw   +1              ;10 -> 11
        retlw   0               ;11 -> 00 (don't care)
        retlw   +1              ;11 -> 01
        retlw   -1              ;11 -> 10
        retlw   0               ;11 -> 11

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;
ScreenTable
    addwf   PCL,F
    goto    Screen1
    goto    Screen2
    goto    Screen3
    goto    Screen4

;;;;;;; End of Tables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;; Mainline program ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Mainline
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    call    Initial             ;Initialize variables and system
    call    InitVFD             ;Initialize the VFD

    movlw   _Info1-Message_Start ; Print message on VFD
    call    DisplayC
    movlw   _Info2-Message_Start
    call    DisplayC

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; MainLoop
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
MainLoop

    call    RPGchange
    call    RPG
    call    DecrementFans       ; sets up the fans to blow according to thier duty cycle
                                ; Stan Gryskiewicz
    call    LoopTime            ; Force loop time to be ten milliseconds

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    decf    LOOPTIME,F              ; decrement looptime and determine if it's zero
    movf    LOOPTIME,W
    btfss   STATUS,Z
    goto    MainLoop
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    bsf     PORTA,2
    bsf     PORTA,1
    MOVLF   MechDelayConst,LOOPTIME

    ; The "once a second subroutines"

    call    GetTemp             ; get the temperature and puts them in degree format into 4 variables
                                ; Justin Dominitz
    call    ControlFan          ; this function converts degrees to power cycles for a fan
                                ; Erik Rainey
    call    ResetFans           ; resets the duty cycles of the fans
                                ; Stan Gryskiewicz
    call    GetFanSpeeds        ; doesn't actually compute fans speeds, it nabs them from the CCp1 registers and chages the mux over every once in a while.
                                ; Erik Rainey
    call    DisplayInfo         ; prints out the information to the VFD, or termial if we wish
                                ; Erik Rainey
    bcf     PORTA,2
    bcf     PORTA,1

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    goto    MainLoop
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;; Initial subroutine ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; This subroutine performs all initializations of variables and registers.

Initial
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    BANK1                       ; Set register access to bank 1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    MOVLF   B'00000110',ADCON1  ; Select PORTE pins for all digital I/O
    clrf    TRISA               ; Set up PORTA
    clrf    TRISB               ; Set up PORTB
    MOVLF   B'10011111',TRISC   ; Set up PORTC
    clrf    TRISD               ; Set up PORTD
    clrf    TRISE               ; Set up PORTE
    MOVLF   249,PR2             ; Set up Timer2 for a looptime of 10 ms
    bsf     PIE1,RCIE           ; we want to jump right to RC stuff though
    bsf     PIE1,CCP1IE         ; enable interrupts on CCP1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    BANK0                       ; Set register access back to bank 0
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    clrf    PORTA               ; Clear Lights, Buzzer, etc...
    MOVLF   H'FF',PORTD         ; Reset Fan Control Lines
    MOVLF   MechDelayConst,LOOPTIME
    MOVLF   B'01001101',T2CON   ; Finish set up of Timer2 (see page 62)
    MOVLF   B'00000101',CCP1CON
    MOVLF   1,BLNKCNT           ; Initialize BLNKCNT

    MOVLF   100,GeneralCycle

    MOVFF   GeneralCycle,DutyCycle0
    MOVFF   GeneralCycle,DutyCycle1
    MOVFF   GeneralCycle,DutyCycle2
    MOVFF   GeneralCycle,DutyCycle3
    MOVFF   GeneralCycle,DutyCycle4
    MOVFF   GeneralCycle,DutyCycle5
    MOVFF   GeneralCycle,DutyCycle6
    MOVFF   GeneralCycle,DutyCycle7

    MOVLF   25,DESIREDTEMP
    MOVLF   0,SCREENNUM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                                ; cross bank stuff
    clrf    TEMPNUM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    return


;;;;;;; InitVFD subroutine ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Initialize the Noritake 16x2 character VFD.
; (Initialize PIC ports prior to calling this subroutine.)
; This subroutine uses a one-byte RAM variable called VFD_TEMP.

InitVFD
    bsf     PORTD,7
    MOVLF   25,DIS_TEMP     ;Wait 1/4 second
InitVFD_1
    call    LoopTime        ;Call LoopTime 25 times
    decfsz  DIS_TEMP,F
    goto    InitVFD_1

    ;VFD_TEMP now equals 0

    bcf     PORTA,4      ;We're writing!

    bcf     PORTA,3      ;RS=0

    MOVLF   H'0C',PORTB  ; Display ON!
    bsf     PORTA,5      ;Drive E high
    bcf     PORTA,5      ;Drive E low so VFD will process input
    call    T40          ;Wait 40 usec

    bsf     PORTA,3      ;RS=1

    MOVLF   2,PORTB      ; medium intensity
    bsf     PORTA,5      ;Drive E high
    bcf     PORTA,5      ;Drive E low so VFD will process input
    call    T40          ;Wait 40 usec

    bcf     PORTA,3      ;RS=0 for command

    MOVLF   H'01',PORTB  ;Clear Display
    bsf     PORTA,5      ;Drive E high
    bcf     PORTA,5      ;Drive E low so VFD will process input
    call    LoopTime
    call    LoopTime
    call    LoopTime

    MOVLF   H'06',PORTB  ;Entry Mode Set
    bsf     PORTA,5      ;Drive E high
    bcf     PORTA,5      ;Drive E low so VFD will process input
    call    T40          ;Wait 40 usec

    MOVLF   H'14',PORTB  ;Cursor Display Shift
    bsf     PORTA,5      ;Drive E high
    bcf     PORTA,5      ;Drive E low so VFD will process input
    call    T40          ;Wait 40 usec

    MOVLF   H'30',PORTB  ;Eight-Bit Interface
    bsf     PORTA,5      ;Drive E high
    bcf     PORTA,5      ;Drive E low so VFD will process input
    call    T40          ;Wait 40 usec

    bcf     PORTD,7
    return

;;;;;;; T40 subroutine ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Pause for 40 microseconds (assumes 4 MHz crystal).

T40
    movlw   12
    movwf   TEMP
T40_1
    decfsz  TEMP,F
    goto    T40_1
    return

;;;;;;; RPGchange subroutine ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; This subroutine looks at the old and new values of the Bourns RPG outputs and
; returns 00000001 for a CW change, 00000000 for no change, or 11111111
; for a CCW change.  This result is returned in DELTARPG.

RPGchange
    movf    PORTC,W     ;Put bottom bits of Port C (RPG) into W
        andlw   B'00000011'     ;Mask off extraneous bits
        iorwf   OLDRPG,W        ;Form four bit value of oldC,oldB,newC,newB
        movwf   DELTARPG        ;Use DELTARPG as temporary variable to hold value
        movwf   OLDRPG          ; as well as OLDRPG
        movlw   B'00001100'     ;Form mask in W
        rlf         OLDRPG,F    ;Move new bits to bit positions 3 and 2
        rlf         OLDRPG,F
        andwf   OLDRPG,F        ;Zero all but the new bits in positions 3 and 2
        movf    DELTARPG,W      ;Restore offset into table
        call    RPGtable        ;Get +1, 0, or -1
        movwf   DELTARPG        ;and return it in DELTARPG
        return

;;;;;;; RPG subroutine ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Whenever the rotary pulse generator (RPG) increments, this subroutine
; increments or decrements the binary number displayed on the lower five LEDs.

RPG
        movf    DELTARPG,W      ;Get +1, 0, or -1 value formed by RPGchange
        addwf   DESIREDTEMP,F
        return

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;

ControlFan

    ; ok, we get the temperatures from the temp0-3 variables. we must somehow
    ; now convert them into desired DutyCycles.
    ; we have two variables, DESIRETEMP and SUMDIFF which are used in this subroutine

    ; Simple method: uses only one sensor and a single fan

    movf    Temp0,W
    subwf   DESIREDTEMP,W   ; find differnce between actual and desired
    movwf   DIFF0

    movf    Temp1,W
    subwf   DESIREDTEMP,W   ; find differnce between actual and desired
    movwf   DIFF1

    movf    Temp2,W
    subwf   DESIREDTEMP,W   ; find differnce between actual and desired
    movwf   DIFF2

    movf    Temp3,W
    subwf   DESIREDTEMP,W   ; find differnce between actual and desired
    movwf   DIFF3

    ; now that we have a diff we add that (it can be negative) to the DutyCycle
    ; this creates a 1:1 relation ship with temp and duty cycle

    btfsc   DIFF0,7 	    ; if DIFF0 is a negative number, bit 7=1
    goto    Control0Negative
    goto    Control0Positive
Control0Positive
    SUB_NOWRAP DutyCycle4,DutyCycle4,DIFF0
    goto Control0End
Control0Negative
    TWOCOMP  DIFF0	    ; two complement DIFF0
    movf     DIFF0,W
    ADD_NOWRAP DutyCycle4,DutyCycle4,DIFF0
Control0End

    btfsc   DIFF1,7 	    ; if DIFF1 is a negative number, bit 7=1
    goto    Control1Negative
    goto    Control1Positive
Control1Positive
    SUB_NOWRAP DutyCycle5,DutyCycle5,DIFF1
    goto Control1End
Control1Negative
    TWOCOMP  DIFF1	    ; two complement DIFF1
    movf     DIFF1,W
    ADD_NOWRAP DutyCycle5,DutyCycle5,DIFF1
Control1End

    btfsc   DIFF2,7 	    ; if DIFF2 is a negative number, bit 7=1
    goto    Control2Negative
    goto    Control2Positive
Control2Positive
    SUB_NOWRAP DutyCycle0,DutyCycle0,DIFF2
    SUB_NOWRAP DutyCycle1,DutyCycle1,DIFF2
    SUB_NOWRAP DutyCycle2,DutyCycle2,DIFF2
    SUB_NOWRAP DutyCycle3,DutyCycle3,DIFF2
    goto Control2End
Control2Negative
    TWOCOMP  DIFF2	    ; two complement DIFF2
    movf     DIFF2,W
    ADD_NOWRAP DutyCycle0,DutyCycle0,DIFF2
    ADD_NOWRAP DutyCycle1,DutyCycle1,DIFF2
    ADD_NOWRAP DutyCycle2,DutyCycle2,DIFF2
    ADD_NOWRAP DutyCycle3,DutyCycle3,DIFF2
Control2End

    btfsc   DIFF3,7 	    ; if DIFF3 is a negative number, bit 7=1
    goto    Control3Negative
    goto    Control3Positive
Control3Positive
    SUB_NOWRAP DutyCycle6,DutyCycle6,DIFF3
    SUB_NOWRAP DutyCycle7,DutyCycle7,DIFF3
    goto Control3End
Control3Negative
    TWOCOMP  DIFF3	    ; two complement DIFF3
    movf     DIFF3,W
    ADD_NOWRAP DutyCycle6,DutyCycle6,DIFF3
    ADD_NOWRAP DutyCycle7,DutyCycle7,DIFF3
Control3End

    ; this simple method will most likely result in an underdamped system.

    return

;;;;;;; GetFanSpeeds ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; nab the 16 bit number from the Fan speed stuff
; and switch the mux

GetFanSpeeds
   ; nab fan speed
   MOVFF    FSPEED1H,FANSPEEDH
   MOVFF    FSPEED1L,FANSPEEDL
   ; switch to another input
   movf     PORTE,W
   addlw    1
   andlw    3
   movwf    PORTE
   ; that's it!
   return

;;;;;;; DecrementFans ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Decrements Fan coutners for duty cycle powering.

DecrementFans

    movf    CurrentCount0,W
    btfss   STATUS,Z
    decf    CurrentCount0,F
    movf    CurrentCount0,W
    btfsc   STATUS,Z
    bcf     PORTD,0

    movf    CurrentCount1,W
    btfss   STATUS,Z
    decf    CurrentCount1,F
    movf    CurrentCount1,W
    btfsc   STATUS,Z
    bcf     PORTD,1

    movf    CurrentCount2,W
    btfss   STATUS,Z
    decf    CurrentCount2,F
    movf    CurrentCount2,W
    btfsc   STATUS,Z
    bcf     PORTD,2

    movf    CurrentCount3,W
    btfss   STATUS,Z
    decf    CurrentCount3,F
    movf    CurrentCount3,W
    btfsc   STATUS,Z
    bcf     PORTD,3

    movf    CurrentCount4,W
    btfss   STATUS,Z
    decf    CurrentCount4,F
    movf    CurrentCount4,W
    btfsc   STATUS,Z
    bcf     PORTD,4

    movf    CurrentCount5,W
    btfss   STATUS,Z
    decf    CurrentCount5,F
    movf    CurrentCount5,W
    btfsc   STATUS,Z
    bcf     PORTD,5

    movf    CurrentCount6,W
    btfss   STATUS,Z
    decf    CurrentCount6,F
    movf    CurrentCount6,W
    btfsc   STATUS,Z
    bcf     PORTD,6

    movf    CurrentCount7,W
    btfss   STATUS,Z
    decf    CurrentCount7,F
    movf    CurrentCount7,W
    btfsc   STATUS,Z
    bcf     PORTD,7

    return

;;;; ResetFans ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; resets the value of the fan counters

ResetFans

    MOVFF   DutyCycle0,CurrentCount0
    MOVFF   DutyCycle1,CurrentCount1
    MOVFF   DutyCycle2,CurrentCount2
    MOVFF   DutyCycle3,CurrentCount3
    MOVFF   DutyCycle4,CurrentCount4
    MOVFF   DutyCycle5,CurrentCount5
    MOVFF   DutyCycle6,CurrentCount6
    MOVFF   DutyCycle7,CurrentCount7

    movf    CurrentCount0,W
    btfss   STATUS,Z
    bsf     PORTD,0
    btfsc   STATUS,Z
    bcf     PORTD,0

    movf    CurrentCount1,W
    btfss   STATUS,Z
    bsf     PORTD,1
    btfsc   STATUS,Z
    bcf     PORTD,1

    movf    CurrentCount2,W
    btfss   STATUS,Z
    bsf     PORTD,2
    btfsc   STATUS,Z
    bcf     PORTD,2

    movf    CurrentCount3,W

    btfss   STATUS,Z
    bsf     PORTD,3
    btfsc   STATUS,Z
    bcf     PORTD,3

    movf    CurrentCount4,W
    btfss   STATUS,Z
    bsf     PORTD,4
    btfsc   STATUS,Z
    bcf     PORTD,4

    movf    CurrentCount5,W
    btfss   STATUS,Z
    bsf     PORTD,5
    btfsc   STATUS,Z
    bcf     PORTD,5

    movf    CurrentCount6,W
    btfss   STATUS,Z
    bsf     PORTD,6
    btfsc   STATUS,Z
    bcf     PORTD,6

    movf    CurrentCount7,W
    btfss   STATUS,Z
    bsf     PORTD,7
    btfsc   STATUS,Z
    bcf     PORTD,7

    return

;;;; SMBus Suroutines ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;

GetTemp

   ; Device 0

   MOVLF   B'00110000',DEVADD
;   MOVLF   H'00',INTADD ;Read Local Temp
   MOVLF   H'01',INTADD ;Read Remote Temp
;   MOVLF   H'02',INTADD ;Read Status Register
   call I2Cin
   movf    DATAIN, W
;   movlw   -55 ;Debug
   movwf   Temp0
   nop
   nop
   nop
   nop
   nop
   nop
   nop
   nop

   ; Device 1

   MOVLF   B'10011000',DEVADD
;   MOVLF   H'00',INTADD ;Read Local Temp
   MOVLF   H'01',INTADD ;Read Remote Temp
;   MOVLF   H'02',INTADD ;Read Status Register
   call I2Cin
   movf    DATAIN, W
   movwf   Temp1
   nop
   nop
   nop
   nop
   nop
   nop
   nop
   nop

   ; Device 2

   MOVLF   B'00110010',DEVADD
;   MOVLF   H'00',INTADD ;Read Local Temp
   MOVLF   H'01',INTADD ;Read Remote Temp
;   MOVLF   H'02',INTADD ;Read Status Register
   call I2Cin
   movf    DATAIN, W
   movwf   Temp2
   nop
   nop
   nop
   nop
   nop
   nop
   nop
   nop

   ; Device 3

   MOVLF   B'10011100',DEVADD
;  MOVLF   H'00',INTADD ;Read Local Temp
   MOVLF   H'01',INTADD ;Read Remote Temp
;   MOVLF   H'02',INTADD ;Read Status Register
   call I2Cin
   movf    DATAIN, W
   movwf   Temp3
   nop
   nop
   nop
   nop
   nop
   nop
   nop
   nop

   return

;;;; Hex2Ascii ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; converts hex to ascii

Hex2Ascii
    andlw   H'0F'
    addlw   256-10      ; sub 10
    btfsc   STATUS,C    ; if C==0 then it was a number else a letter
    addlw   H'07'       ; add extra letter offset
    addlw   H'3A'       ; add the 10 back plus enough to make it ASCII
    return

;;;; Ascii2Hex ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; converts an ascii character to a hex nibble

Ascii2Hex
    addlw   256-48      ; subtract 'F'
    movwf   TEMP        ; save in temp
    addlw   256-10      ; subtract 10
    movf    TEMP,W      ; save
    btfsc   STATUS,C    ; check for  borrow
    addlw   256-7       ; subtract 7
    andlw   H'0F'       ; mask bits
    return

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;

DisplayInfo
    call    VFDReset

    ; alternate between tempurature readings and fan speeds and desired temp
    ; and a promo screen!

    incf    SCREENNUM,F
    movlw   3
    andwf   SCREENNUM,F
    movf    SCREENNUM,W
    call    ScreenTable
    return

Screen1

    movlw   _1-Message_Start
    call    DisplayC
    movf    Temp0,W
    call    VFDdecimal
    DEGREES

    movlw   _2-Message_Start
    call    DisplayC
    movf    Temp1,W
    call    VFDdecimal
    DEGREES

    ; line 2 now...

    movlw   _3-Message_Start
    call    DisplayC
    movlw   H'20'
    call    VFDbyte
    movlw   A'X'
    call    VFDbyte
    movlw   A'X'
    call    VFDbyte
    DEGREES

    movlw   _4-Message_Start
    call    DisplayC
    movf    Temp3,W
    call    VFDdecimal
    DEGREES

    return

Screen2

    ; display the fan percentages

    movf    DutyCycle0,W
    call    VFDdecimal
    movlw   H'25'
    call    VFDbyte

    movf    DutyCycle1,W
    call    VFDdecimal
    movlw   H'25'
    call    VFDbyte

    movf    DutyCycle2,W
    call    VFDdecimal
    movlw   H'25'
    call    VFDbyte

    movf    DutyCycle3,W
    call    VFDdecimal
    movlw   H'25'
    call    VFDbyte

    VFDNEWLINE             ; takes us to the next line

    movf    DutyCycle4,W
    call    VFDdecimal
    movlw   H'25'
    call    VFDbyte

    movf    DutyCycle5,W
    call    VFDdecimal
    movlw   H'25'
    call    VFDbyte

    movf    DutyCycle6,W
    call    VFDdecimal
    movlw   H'25'
    call    VFDbyte

    movf    DutyCycle7,W
    call    VFDdecimal
    movlw   H'25'
    call    VFDbyte

    return

Screen3

    movlw   _Desired-Message_Start
    call    DisplayC

    movf    DESIREDTEMP,W
    call    VFDdecimal
    DEGREES

    movlw   _Info2-Message_Start
    call    DisplayC
    return

Screen4
    MOVLF   0,SCREENNUM
    goto    Screen1
    return

;;;;;;;;DisplayC subroutine;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; This subroutine is called with W containing the offset from  CDS to the
; beginning of the desired constant display string. It uses a one-byte LCD_TEMP
; to the next byte in the display string

DisplayC
    movwf   DIS_TEMP     ;Save pointer

    call    DisplayC_Table    ;Get byte from string into W
    incf    DIS_TEMP,F   ;Point to the next byte
    movwf   TEMP

    bcf     PORTA,3      ;Drive RS pin low for cursor positioning code
    bcf     PORTA,4      ;Drive R/~W low for writing
    bsf     PORTA,5
    MOVFF   TEMP,PORTB      ;Position Code
    bcf     PORTA,5

    bsf     PORTA,3      ;Drive RS high for Character writing
DisplayC_1
    call    DisplayC_Table    ;Get byte from string into W
    incf    DIS_TEMP,F   ;Point to the next byte
    iorlw   0            ;Set Z if end of string
    btfsc   STATUS,Z     ;if not, then go on
    goto    DisplayC_done
    movwf   TEMP

    bsf     PORTA,5      ;Strobe E
    movwf   PORTB        ;Write byte
    bcf     PORTA,5      ;Strobe E

    goto    DisplayC_1
DisplayC_done
    return

;;;; VFDReset ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; reset the vfd, clears the display, and sets the cursor to 0.

VFDReset
    bcf     PORTA,3
    bcf     PORTA,4
    bsf     PORTA,5
    MOVLF   H'80',PORTB
    bcf     PORTA,5
    bsf     PORTA,5
    MOVLF   H'01',PORTB
    bcf     PORTA,5
    bsf     PORTA,3
    call    LoopTime
    call    LoopTime
    call    LoopTime
    return

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;
;

VFDdecimal
    call    HexToDecimal
    movf    Digit2,W 		;Output '1', ' ', or '-'
    call    VFDbyte
    movf    TempX,W
    call    VFDdebug
    return

;;;; VFDdebug ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;   sends W out onto the VFD

VFDdebug
    movwf   TEMP
    swapf   TEMP,W
    call    Hex2Ascii
    call    VFDbyte     ; send it out
    movf    TEMP,W
    call    Hex2Ascii
    call    VFDbyte     ; send it out
    movf    TEMP,W
    return

;;; VFDbyte ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; send byte to VFD

VFDbyte
    bsf     PORTA,5
    movwf   PORTB
    bcf     PORTA,5
    return


;;;;;; DisplayT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; display the strings on the terminal
; just like DisplayC

DisplayT
    movwf   DIS_TEMP
DisplayT_1
    call    DisplayC_Table
    incf    DIS_TEMP,F
    iorlw   0                   ; changes z bit
    btfsc   STATUS,Z
    goto    DisplayT_done

    call    TXbyte

    goto    DisplayT_1
DisplayT_done
    return

;;;;;;; SendDebug ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; put a byte in W then call this to send it out over the USART

SendDebug
    movwf   TEMP
    swapf   TEMP,W
    call    Hex2Ascii
    call    TXbyte
    movf    TEMP,W
    call    Hex2Ascii
    call    TXbyte
    movf    TEMP,W
    return

;;;;;;; TXbyte ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; w is to be sent out over USART

TXbyte

TXloop
    btfss   PIR1,TXIF
     goto   TXloop
    movwf   TXREG
TXEnd
    return

;;;;;;; RCbyte ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; W is received over the USART

RCbyte

RCloop
    btfss   PIR1,RCIF
     goto   RCloop
    movf    RCREG,W
RCEnd
    return

;;;;;;; EchoServer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; spits back whatever is on the receive line leaving RCREG in W

Echo
    call    RCbyte
    call    TXbyte
    return                   ; this keeps the received byte in W

;;;;;;; LoopTime subroutine ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; This subroutine waits for Timer2 to complete its ten millisecond count
; sequence.

LoopTime
    btfss   PIR1,TMR2IF    ;Check whether ten milliseconds are up
    goto    LoopTime
    bcf     PIR1,TMR2IF    ;Clear flag
    return


;;;; I2C Subroutines ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;taken directly from John Peatman's PIC microcontroller book
; http://www.picbook.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I2Cout
    call    Start
    movf    DEVADD,W
    call    TX
    movf    INTADD,W
    call    TX
    movf    DATAOUT,W
    call    TX
    call    Stop
    return
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I2Cin
    call    Start
    movf    DEVADD,W
    call    TX
    movf    INTADD,W
    call    TX
    call    ReStart
    movf    DEVADD,W
    iorlw   B'00000001'
    call    TX
    bsf     TXBUFF,7
    call    RX
    movwf   DATAIN
    call    Stop
    return
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Start
    movlw   B'00111011'
    movwf   SSPCON
    bcf     PORTC,SDA
    bcf     PORTC,SCL
    movlw   TRISC
    movwf   FSR
ReStart
    bsf     INDF,SDA
    bsf     INDF,SCL
    delay   0,1,2
    bcf     INDF,SDA
    delay   0,1,2
    bcf     INDF,SCL
    return
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Stop
    bcf     INDF,SDA
    bsf     INDF,SCL
    delay   0,1,2
    bsf     INDF,SDA
    return
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
TX
    movwf   TXBUFF
    bsf     STATUS,C
TX_1
    rlf     TXBUFF,F
    movf    TXBUFF,F
    btfss   STATUS,Z
    call    BitOut
    btfss   STATUS,Z
    goto    TX_1
    call    BitIn
    movlw   B'00000001'
    andwf   RXBUFF,W
    return
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
RX
    movlw   B'00000001'
    movwf   RXBUFF
RX_1
    rlf     RXBUFF,F
    call    BitIn
    btfss   STATUS,C
    goto    RX_1
    rlf     TXBUFF,F
    call    BitOut
    movf    RXBUFF,W
    return
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
BitOut
    bcf     INDF,SDA
    btfsc   STATUS,C
    bsf     INDF,SDA
    bsf     INDF,SCL
    nop
    nop
    nop
    nop
    nop
    nop
    delay   0,1,2
    bcf     INDF,SCL
    bcf     STATUS,C
    return
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
BitIn
    bsf     INDF,SDA
    bsf     INDF,SCL
    nop
    nop
    nop
    nop
    nop
    nop
    bcf     RXBUFF,0
    btfsc   PORTC,SDA
    bsf     RXBUFF,0
    bcf     INDF,SCL
    return

;;;;;;; IntService interrupt service routine ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; This interrupt service routine fields all interrupts. It first sets aside W
; and STATUS. It assumes that direct addressing will not be used in the
; mainline code to access Bank 1 addresses (once the Initial subroutine has
; been executed and interrupts enabled). It polls each possible interrupt
; source to determine whether it needs service.

IntService
; Set aside W and STATUS
        movwf   W_TEMP          ;Copy W to RAM
        swapf   STATUS,W        ;Move STATUS to W without affecting Z bit
        movwf   STATUS_TEMP     ;Copy to RAM (with nibbles swapped)

; Execute polling routine
Poll
        btfsc   PIR1,CCP1IF     ;Test RCIF flag
        goto    CCP1Handler

; Restore STATUS and W and return from interrupt
        swapf   STATUS_TEMP,W   ;Restore STATUS bits (unswapping nibbles)
        movwf   STATUS          ; without affecting Z bit
        swapf   W_TEMP,F        ;Swap W_TEMP
        swapf   W_TEMP,W        ; and swap again into W without affecting Z bit
        retfie                      ;Return from mainline code; reenable interrupts

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Handlers

CCP1Handler

        bcf     PIR1,CCP1IF     ; clear the interrupt flag
        btfsc   CCP1CON,0       ; skip if looking for falling edge
        goto    DetectRisingEdge
        SUB1616 FSPEED0H,FSPEED0L,CCPR1H,CCPR1L,FSPEED1H,FSPEED1L
        bsf     CCP1CON,0       ; interrupt on rising edge
        goto    Poll
DetectRisingEdge
        MOVFF   CCPR1H,FSPEED0H
        MOVFF   CCPR1L,FSPEED0L
        bcf     CCP1CON,0       ; interrupt on falling edge
        goto    Poll

;;;;; HexToDecimal Subroutines ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Justin Domnitz, April 16, 2000
;

HexToDecimal

   ; TempX value has been passed in as W

   ; Is TempX > 99 C?
   movwf   TempX
   btfsc   TempX,7
   goto	   LessThan0
   movlw   100
   subwf   TempX, F                     ; Subtract 100 from W
   btfss   STATUS, C                    ; If carry bit is 1 skip next instruction b/c TempX > 99.
   goto    LessThan100
   goto    GreaterThan99

GreaterThan99                           ; TempX > 99 C So...
   MOVLF   H'31', Digit2                ; Set Digit2 = '1'
   goto RestOfNumber

LessThan100                             ; TempX < 99 C So...
   movlw   100
   addwf   TempX, F
   MOVLF   H'20', Digit2                ; Set Digit2 = ' '
   goto RestOfNumber

LessThan0                               ; TempX < 0 C So...
   MOVLF   H'2D', Digit2                ; Set Digit2 = '-'
   TWOCOMP TempX
   goto RestOfNumber

RestOfNumber

   MOVLF   0, Digit1                    ; Initialize Digit1 to 0.
   MOVLF   0, Digit0                    ; Initialize Digit0 to 0.

TensDigitLoop
   MOVFF   TempX, Digit0
   movlw   10                           ; Put 10 into W.
   subwf   TempX, F                     ; Subtract 10 from TempX
   btfss   STATUS, C                    ; If carry bit is 1 skip next instruction b/c TempX > 10.
   goto    OnesDigit
   incf    Digit1, F                    ; Increment tens digit.
   goto    TensDigitLoop

OnesDigit
   MOVFF   Digit1, TempX                ; Store tens digit in lower nibble of TempX.
   swapf   TempX, W                     ; Put tens digit into upper nibble of W.
   iorwf   Digit0, W                    ; Or W (TempX) with Digit0.
   movwf   TempX

   return

;
; Justin Domnitz, April 16, 2000
;
;;;;; HexToDecimal Subroutines ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    end
;