; Tuesday 01:48:31 pm 25/06/91 ; Check relay use disabled 2.6 ; Checksum on profiles 2.7 ; Speed default motor 2.8 ; Time-out of triac drives 3.0 ; and motor speed display improved ; Belt speed table moved to end (unencrypted) 3.1 ; Password changed and moved to end 4.0 ; Deleting profiles added ; Editing input changed ; Entry validation improved ; Default profile moved to 0 ; PIO initialised earlier PioAD EQU %0 0 1111 00 ; PIO registers PioBD EQU %0 0 1111 01 ; PioAK EQU %0 0 1111 10 ; PioBK EQU %0 0 1111 11 ; LcdD EQU %1 1 11111 1 ; LCD registers LcdK EQU %1 1 11111 0 ; ADC_0 EQU #4000 ; Read only ! Key_R EQU #4001 ; Low 5 bits Latch_0 EQU #4002 ; Write only Latch_0_Def EQU %000 0 1 1 1 0 ; Clear int Triac_Port EQU #4003 ; Relays | Triacs cDeg EQU #DF ; Degree symbol dwMotor_Time EQU 30*16 ; Motor control time out Motor_Min EQU 50 ; Minimum motor voltage Low_SP EQU RamBott-100 ; Fail if below High_SP EQU RamBott+1 ; Fail if above or equal Low_PC EQU Start ; Fail if below High_PC EQU Last_Inst ; Fail if above or equal Pulse_Cnt EQU 16 ; No. of pulses to fire triac Para_Sys EQU #0000 ; Escape enXOR EQU #78 ; Encryption values enADD EQU #12 ; enMASK EQU #42 ; FMR_Rate EQU 60 ; Error flash rate CRU_iCount EQU 7 ; Triac fail retry count RamBott EQU #E100 ; Ram starts here nProfiles EQU 400 ; Maxm no. of profiles L_D_Range EQU 3 ; Permissable demand variation ; Remember Para_Sys in dwMan !!! ORG #0000 ; Base EQU * ; CHECKSUM C ; Clear the assemblers checksums ; Real zeus supports checksumming the output data JR Start ; DEFS 4,#FF ; Int_Vector DEFW Int_Routine ; Point at routine Start LD SP,RamBott ; DI ; Kill ints at first CALL Triacs_Valid ; Reset time-out CALL Init_LCD ; Reset and clear it CALL Init_Ports ; Reset the PIO CALL Init_Errors ; Clear the error flags CALL Init_Relay_Use ; Clear the triac test vars CALL Power_Up_Delay ; Wait for reset to end CALL Reset_Lights ; Setup the traffic lights ; Assert startup profile LD A,1 ; Set the flag LD (Startup),A ; ; Fall into normal restart Restart CALL Init_Ports ; CALL Init_Keys ; CALL Init_Ints ; Start interrupt routine CALL Init_Ports_1 ; Reset after Init_Ints LD HL,100 ; Initial motor speed LD (Motor_Speed),HL ; dwReset XOR A ; Kill triacs (relays) LD (Triacs),A ; LD (Triac_Port),A ; CALL Init_LCD ; Reset and clear it ; Kill the lights LD A,%0 1 0 ; Lights LD (Lights),A ; CALL Show_Lights ; ; Now, do we want to start in profile 0 ? LD A,(Startup) ; Flag set ? OR A ; JP NZ dwDefault ; Yes, use default ; No, normal LD IX,Password1 ; String for password 1 LD IY,Password2 ; String for password 2 Init_Lp LD HL,sInit ; Show CALL Send_LCD_Str ; CALL ReadKey ; Scan the keyboard CALL Triacs_Valid ; Clear time-out PUSH AF ; Save char CALL Read_ADC ; Get inputs POP AF ; Restore char JR NC Init_Lp ; None pressed CP (IX) ; Next char in password ? JR NZ Init_Not_1 ; No, reset it INC IX ; Step ptr BIT 7,(IX) ; End of password ? JR Z Init_2 ; No, carry on JP Code_1 ; Code 1 entered Init_Not_1 LD IX,Password1 ; Reset ptr Init_2 XOR #5A ; Change case CP (IY) ; Next char in password 2? JR NZ Init_Not_2 ; No, reset it INC IY ; Step ptr BIT 7,(IY) ; End of password ? JR Z Init_3 ; No, carry on JP Code_2 ; Code 2 entered Init_Not_2 LD IY,Password2 ; Reset ptr Init_3 XOR #5A ; Change case CP #08 ; Delete a profile ? JP Z dwDelete ; Do it CP "P" ; Use profile ? JP Z dwProfile ; Do it CP "M" ; Manual ? JR NZ Init_Lp ; JP dwManual ; Do it gPara_Sys DI ; Kill the watch-dog JP Para_Sys ; Code_1 LD IX,Menu_1 ; Show this CALL Use_Menu ; JP Restart ; Done Code_2 LD IX,Menu_2 ; Show this CALL Use_Menu ; JP Restart ; Done Use_Menu CALL Clear_LCD ; Clear LD HL,(IX) ; Get string CALL Print_Str ; Show it UM_Lp CALL Triacs_Valid ; Clear timer CALL ReadKey ; Scan the keyboard JR NC UM_Lp ; None, try again ; Got a key CP #0D ; This option ? JR Z UM_Select ; Yes CP #08 ; Cancel ? RET Z ; Yes, done LD DE,-4 ; Offset CP "U" ; Move up ? JR Z UM_Next ; LD DE,4 ; Offset CP "D" ; Move down ? JR NZ UM_Lp ; UM_Next PUSH IX ; Check if valid move POP HL ; ADD HL,DE ; Point at it LD A,(HL) ; 0 ? INC HL ; OR (HL) ; JR Z UM_Lp ; Not a valid move ADD IX,DE ; Move JR Use_Menu ; Show display UM_Select PUSH IX ; Save ptr LD HL,(IX+2) ; Vector CALL CallHL ; Call it POP IX ; Restore JR Use_Menu ; Loop CallHL JP (HL) ; Vectored gosub Return RET ; Done P1_Test CALL Clear_LCD ; Clear it LD A,%1 1 1 1 0 0 0 0 ; Relays := ON LD (Triacs),A ; LD HL,sP1_Test_Str ; Show str CALL Print_Str ; P1_Test_Lp CALL Triacs_Valid ; Clear timer CALL ReadKey ; Get a key JR NC P1_T_1 ; None CP #08 ; Cancel ? JR NZ P1_T_1 ; No, loop LD A,%0 0 0 0 0 0 0 0 ; Relays/Triacs := OFF LD (Triacs),A ; RET ; Done P1_T_1 CALL Read_ADC ; Read_ADC LD A,%0 1001000 ; Home CALL Set_Cursor ; LD IY,cADC_0 ; Show them all LD B,4 ; CALL SA_Lp ; Do 4 zones XOR A ; All off LD HL,Key_Data+kn1 ; "1" BIT 5,(HL) ; JR Z P1T_1 ; No SET 0,A ; Set it P1T_1 LD HL,Key_Data+kn2 ; "2" BIT 5,(HL) ; JR Z P1T_2 ; No SET 1,A ; Set it P1T_2 LD HL,Key_Data+kn3 ; "3" BIT 5,(HL) ; JR Z P1T_3 ; No SET 2,A ; Set it P1T_3 LD HL,Key_Data+kn4 ; "4" BIT 5,(HL) ; JR Z P1T_4 ; No SET 3,A ; Set it P1T_4 OR %1111 0000 ; Turn relays on LD (Triacs),A ; Set them LD C,A ; Save it LD A,%0 0001000 ; Home CALL Set_Cursor ; LD B,3 ; Show 4 of them P1T_Lp2 CALL P1T_Show ; "ON/OFF" LD HL,sBlank ; Move cursor CALL Print_Str ; DJNZ P1T_Lp2 ; Loop CALL P1T_Show ; Show last JR P1_Test_Lp ; Loop P1T_Show SRL C ; Get next bit PUSH BC ; Save LD HL,sON ; " ON " JR C P1T_S1 ; Show it LD HL,sOFF ; " OFF" P1T_S1 CALL Print_Str ; Show it POP BC ; RET ; Done P1_Define RET ; Null routine P1_Erase CALL Clear_LCD ; Clear it LD HL,sP1_Erase_Done ; Show str CALL Print_Str ; LD HL,Profiles ; Start of profile area LD DE,Profiles+1 ; LD BC,nProfiles * 16 -1; LD (HL),#FF ; Null marker LDIR ; Clear memory ; Clear the default LD HL,Default_Profile ; Point at it LD DE,Default_Profile+1; LD BC,16 - 1 ; LD (HL),#FF ; Clear it LDIR ; Clear RAM LD B,20 ; c One second CALL Read_Key_Delay ; RET ; Done P1_Cal CALL Clear_LCD ; Clear it LD HL,sP1_Cal_Str ; Show str CALL Print_Str ; P1_Cal_Lp CALL ReadKey ; Get a key RET C ; LD A,%0000 0000 ; Clear them LD (Triacs),A ; CALL Triacs_Valid ; Clear timer CALL Read_ADC ; Read_ADC LD A,%0 0001000 ; Home CALL Set_Cursor ; LD IY,cADC_4 ; Show them all LD B,4 ; CALL SA_Lp ; Do first 4 LD A,%0 1001000 ; Next line CALL Set_Cursor ; LD IY,cADC_0 ; Show them all LD B,4 ; CALL SA_Lp ; Show next 6 JR P1_Cal_Lp ; Loop SA_Lp1 LD HL,sBlank ; Move cursor CALL Print_Str ; SA_Lp PUSH BC ; Save count LD HL,(IY) ; Get it CALL Write_Number ; Show it POP BC ; INC IY ; INC IY ; DJNZ SA_Lp1 ; Loop RET ; Done ; Set the warning light limits P1_Limit CALL Clear_LCD ; Clear it LD HL,sP1_Limit_Str ; Show this CALL Print_Str ; ; Show the limits CALL Show_Limits ; Show them ; Edit them ? P1_L_Lp CALL Get_A_Key ; Get a key CP "E" ; Edit ? JR Z P1_L_Edit ; Yes, skip RET ; Exit P1_L_Edit CALL Edit_Limits ; Yes, edit them JR P1_L_Lp ; Loop RET ; Done ; Show the warning limits Show_Limits LD IX,Limit_Table ; X,Ptrs SL_Lp BIT 7,(IX) ; Done ? RET NZ ; Yes, exit LD A,(IX) ; X CALL Set_Cursor ; LD HL,(IX+1) ; Ptr to var PUSH HL ; Save ptr POP IY ; LD HL,(IY) ; Get number CALL Write_Number ; Show it INC IX ; Step ptr INC IX ; INC IX ; JR SL_Lp ; Loop (EDIT) ; Edit the warning limits Edit_Limits LD IX,Limit_Table ; X,Ptrs EL_Lp BIT 7,(IX) ; Done ? RET NZ ; Yes, exit LD A,(IX) ; X CALL Set_Cursor ; LD HL,(IX+1) ; Ptr to var PUSH HL ; Save ptr POP IY ; CALL Input_Number ; Giz a number JR C EL_Ignore ; Don't bother LD (IY),HL ; Save it EL_Ignore LD A,(IX) ; X CALL Set_Cursor ; LD HL,(IY) ; Get number CALL Write_Number ; Show it INC IX ; Step ptr INC IX ; INC IX ; JR EL_Lp ; Loop (EDIT) ; Data for editing limits Limit_Table DEFB 8 ; First temp. DEFW Limit_RF_Above ; DEFB 72 ; DEFW Limit_RF_Below ; DEFB 17 ; DEFW Limit_P2_Above ; DEFB 81 ; DEFW Limit_P2_Below ; DEFB 26 ; DEFW Limit_P1_Above ; DEFB 90 ; DEFW Limit_P1_Below ; DEFB 35 ; DEFW Limit_SZ_Above ; DEFB 99 ; DEFW Limit_SZ_Below ; DEFB #80 ; End ; Drive the machine using the pots dwManual CALL Clear_LCD ; Reset and clear it LD HL,sManual ; Show this CALL Print_Str ; ; Reset the lights CALL Reset_Lights ; Assume we have changed dwMan_Lp CALL Get_A_Key_Pots ; Scan the keyboard CP "S" ; Save ? JP Z dwMan_Save ; Yes, call it CP "P" ; Use profile ? JP Z dwProfile ; Do it CP #08 ; Cancel ? JP Z dwReset ; Exit ; CP "E" ; Edit ? ; JP Z gPara_Sys ; Exit CP "R" ; Motor speed ? JR NZ dwMan_Lp ; No, loop CALL dwMotorSpeed ; Use this display JP dwManual ; Remain here dwMan_Save CALL dwSave ; Save current settings as a profile JR dwManual ; Done, continue ; Delete a profile dwDelete CALL Clear_LCD ; Reset and clear it LD HL,sDelete ; Show this CALL Print_Str ; ; Get a key dwD_Lp CALL ReadKey ; Scan the keyboard CALL Triacs_Valid ; Clear time-out PUSH AF ; Save char CALL Read_ADC ; Get inputs POP AF ; Restore char JR NC dwD_Lp ; None pressed ; Is it accept ? CP #0D ; ENTER ? JP NZ dwReset ; No, exit ; Next page LD HL,sSave ; Show this CALL Print_Str ; LD A,%0 1000001 ; Place cursor CALL Set_Cursor ; CALL Input_Number ; Get HL := 0 .. 999 JP C dwReset ; Fail, ignore ; Clear this profile CALL Get_Profile_Ptr ; Point at this profile JP C dwReset ; Failed ; Clear this profile LD (HL),#FF ; Not used flag INC HL ; LD (HL),#FF ; INC HL ; LD B,14 ; Length dwD_Lp2 LD (HL),0 ; Clear it INC HL ; Skip DJNZ dwD_Lp2 ; Loop ; Done, return JP dwReset ; Done ; Use a default profile dwDefault LD HL,0 ; Select profile 0 LD (Current_Profile),HL; CALL Get_Profile_Ptr ; Make it a ptr JR C dwD_Kill ; Valid ?, skip if not ; Test if valid profile LD A,(HL) ; Valid ? INC HL ; AND (HL) ; (FFFF = not used) DEC HL ; INC A ; = FFFF ? JR Z dwD_Kill ; Yes, skip (not valid) ; Check the checksum CALL Calc_Checksum ; Is it valid ? JR Z dwP_2 ; Yes, skip ; Not valid dwD_Kill CALL Clear_Setup ; Kill the flag JP dwReset ; Ignore default ; Clear the setup flag Clear_Setup PUSH AF ; Save XOR A ; Kill the startup flag LD (Startup),A ; POP AF ; Restore RET ; Done ; Use a profile dwProfile CALL Clear_LCD ; Reset and clear it LD HL,sSave ; Show this CALL Print_Str ; LD A,%0 1000001 ; Place cursor CALL Set_Cursor ; CALL Input_Number ; Get HL := 0 .. 999 JP C dwReset ; Fail LD (Current_Profile),HL; Save the current profile ; Fall into . . dwPro_New LD HL,(Current_Profile); Get current one CALL Clear_LCD ; Reset and clear it CALL Get_Profile_Ptr ; Make it a ptr JR NC dwP_1 ; Valid LD HL,sSave_IP ; Invalid number CALL Print_Str ; CALL Get_A_Key ; Pause JR dwProfile ; Try again dwP_1 LD A,(HL) ; Valid ? INC HL ; AND (HL) ; (FFFF = not used) DEC HL ; INC A ; = FFFF ? JR NZ dwP_2a ; No, check checksum dwP_No_Profile LD HL,sProfile_NP ; Doesn't exist CALL Print_Str ; CALL Get_A_Key ; Pause JR dwProfile ; Try again ; Now check checksum dwP_2a CALL Calc_Checksum ; Is it the same ? JR NZ dwP_No_Profile ; No, fail dwP_2 LD DE,Motor_Speed ; Vars LD BC,16 ; Length LDIR ; Read them ; Kick the lights, we have a new one CALL Reset_Lights ; Go back to orange dwPro_Start CALL Clear_LCD ; Reset and clear it LD HL,sProfile ; Show this CALL Print_Str ; LD A,%0 0000011 ; Home + 3 CALL Set_Cursor ; LD HL,(Current_Profile); Show the current profile CALL Write_Number ; CALL Show_Pro_Volts ; Show them dwPro_Lp CALL Get_A_Key_Auto ; Scan the keyboard ; A key, kill the startup flag CALL Clear_Setup ; Don't use default ; Now examine the key CP "S" ; Save ? JP Z dwPro_Save ; Yes, call it CP "E" ; Edit ? JP Z dwPro_Edit ; Yes, do it CP "M" ; Use manual ? JP Z dwManual ; Do it CP "P" ; Use profile ? JP Z dwProfile ; Do it CP "U" ; Next profile ? JR Z dwPro_Up ; CP "D" ; Last profile ? JP Z dwPro_Down ; CP #08 ; Cancel ? JP Z dwReset ; Exit CP #0D ; ACCEPT ? JP Z dwPro_New ; Reload CP "R" ; Motor speed ? JR NZ dwPro_Lp ; No, loop CALL dwMotorSpeed ; Use this display JP dwPro_Start ; Remain here dwPro_Edit LD IX,Edit_Table ; X,Ptrs dwPE_Lp BIT 7,(IX) ; Done ? JR NZ dwPro_Lp ; Yes, loop LD A,(IX) ; X CALL Set_Cursor ; LD HL,(IX+1) ; Ptr to var PUSH HL ; Save ptr POP IY ; CALL Input_Number ; Giz a number JR C dwPE_Ignore ; Don't bother LD (IY),HL ; Save it dwPE_Ignore LD A,(IX) ; X CALL Set_Cursor ; LD HL,(IY) ; Get number CALL Write_Voltage ; Show it INC IX ; Step ptr INC IX ; INC IX ; JR dwPE_Lp ; Loop (EDIT) Edit_Table DEFB 8 ; First temp. DEFW Demand_0 ; DEFB 17 ; DEFW Demand_1 ; DEFB 26 ; DEFW Demand_2 ; DEFB 35 ; DEFW Demand_3 ; DEFB #80 ; End dwPro_Up LD HL,(Current_Profile); Get next CALL Get_Profile_Ptr ; Point at it PUSH HL ; Get ptr POP IX ; LD BC,(Current_Profile); Get no. LD DE,16 ; Length dwP_U_Lp LD HL,nProfiles ; Last one ? OR A ; SBC HL,BC ; JP Z dwPro_Lp ; None INC BC ; Next ADD IX,DE ; Next LD A,(IX) ; Valid ? AND (IX+1) ; INC A ; JR Z dwP_U_Lp ; Not set, loop ; Check checksum PUSH IX ; Point at it POP HL ; CALL Calc_Checksum ; Is it valid ? JR NZ dwP_U_Lp ; No, loop JP dwVirt_New ; Show it dwPro_Down LD HL,(Current_Profile); Get next CALL Get_Profile_Ptr ; Point at it PUSH HL ; Get ptr POP IX ; LD BC,(Current_Profile); Get no. LD DE,-16 ; Length dwP_D_Lp LD HL,0 ; Last one ? OR A ; SBC HL,BC ; JP Z dwPro_Lp ; None DEC BC ; Next ADD IX,DE ; Next LD A,(IX) ; Valid ? AND (IX+1) ; INC A ; JR Z dwP_D_Lp ; Not set, loop ; Check checksum PUSH IX ; Point at it POP HL ; CALL Calc_Checksum ; Is it valid ? JR NZ dwP_D_Lp ; No, loop ; Show it dwVirt_New LD (Virtual_Profile),BC; Save it LD HL,(Current_Profile); Same ? OR A ; SBC HL,BC ; JP Z dwPro_Start ; Use standard routines dwVirt_Start CALL Clear_LCD ; Reset and clear it LD HL,sProfile ; Show this CALL Print_Str ; LD A,%0 0000000 ; Home CALL Set_Cursor ; LD A," " ; Kill "P" CALL Print ; CALL Show_Virt_Volts ; Show them dwVirt_Lp_F1 LD A,%0 0000011 ; Home + 3 CALL Set_Cursor ; LD HL,(Virtual_Profile); Show the current profile CALL Write_Number ; LD C,0 ; Text on display dwVirt_Lp_F LD A,24 ; Off-display CALL Set_Cursor ; LD B,5 ; Flash rate dwVirt_Lp PUSH BC ; Save flash rate CALL ReadKey ; Scan the keyboard PUSH AF ; Save char CALL Read_ADC ; Get inputs CALL Drive_Outputs ; Drive the triacs CALL Fail_Messages ; Flash the fail messages CALL Show_Volts_Actual ; Show them POP AF ; Restore char POP BC ; Restore flash rate JR NC dwVirt_Flash ; No key CP #08 ; Cancel ? JP Z dwPro_New ; Return CP "U" ; Up ? JR Z dwVirt_Up ; CP "D" ; Down ? JP Z dwVirt_Down ; CP "R" ; Motor ? JR Z dwVirt_Motor ; CP #0D ; "ACCEPT" ? JR Z dwVirt_Set ; CP "M" ; Use manual ? JP Z dwManual ; Do it CP "P" ; Use profile ? JP Z dwProfile ; Do it dwVirt_Flash DJNZ dwVirt_Lp ; Loop INC C ; Change state BIT 0,C ; JR Z dwVirt_Lp_F1 ; Show number LD A,%0 0000011 ; Home + 4 CALL Set_Cursor ; LD HL,sVirt_Spc ; " " CALL Print_Str ; JP dwVirt_Lp_F ; Loop dwVirt_Motor CALL Clear_LCD ; Clear LCD LD HL,sMotorSpeed ; Show this CALL Print_Str ; LD A,%0 0001110 ; Home + 14 CALL Set_Cursor ; LD HL,(IX) ; Show it CALL Show_Motor_Speeds ; Show them LD A,%0 0011000 ; Off screen CALL Set_Cursor ; dwVM_Lp CALL ReadKey ; Scan the keyboard PUSH AF ; Save char CALL Read_ADC ; Get inputs CALL Drive_Outputs ; Drive the triacs POP AF ; Restore char LD HL,Key_Data+knMO ; "MOTOR" BIT 5,(HL) ; JR NZ dwVM_Lp ; Still pressed JP dwVirt_Start ; Done dwVirt_Set LD HL,(Virtual_Profile); save as current LD (Current_Profile),HL; JP dwPro_New ; Do it dwVirt_Up PUSH IX ; Save ptr PUSH BC ; Save flash LD HL,(Virtual_Profile); Get next CALL Get_Profile_Ptr ; Point at it PUSH HL ; Get ptr POP IX ; LD BC,(Virtual_Profile); Get no. LD DE,16 ; Length dwV_U_Lp LD HL,nProfiles ; Last one ? OR A ; SBC HL,BC ; JP Z dwV_U_None ; None INC BC ; Next ADD IX,DE ; Next LD A,(IX) ; Valid ? AND (IX+1) ; INC A ; JR Z dwV_U_Lp ; Not set, loop ; Checksum ? PUSH IX ; POP HL ; CALL Calc_Checksum ; Valid ? JR NZ dwV_U_Lp ; No, loop ; Valid POP AF ; Lose BC POP AF ; Lose IX JP dwVirt_New ; Show it dwV_U_None POP BC ; Restore flash POP IX ; Restore ptr JP dwVirt_Flash ; Continue flashing dwVirt_Down PUSH IX ; Save ptr PUSH BC ; Save flash data LD HL,(Virtual_Profile); Get next CALL Get_Profile_Ptr ; Point at it PUSH HL ; Get ptr POP IX ; LD BC,(Virtual_Profile); Get no. LD DE,-16 ; Length dwV_D_Lp LD HL,0 ; Last one ? OR A ; SBC HL,BC ; JP Z dwV_U_None ; None DEC BC ; Next ADD IX,DE ; Next LD A,(IX) ; Valid ? AND (IX+1) ; INC A ; JR Z dwV_D_Lp ; Not set, loop ; Checksum ? PUSH IX ; POP HL ; CALL Calc_Checksum ; Valid ? JR NZ dwV_D_Lp ; No, loop ; Valid POP AF ; Lose BC POP AF ; Lose IX JP dwVirt_New ; Show it dwPro_Save CALL dwSave ; Save current settings as a profile JP dwPro_Start ; Done, continue dwSave CALL Clear_LCD ; Reset and clear it LD HL,sSave ; Show this CALL Print_Str ; LD A,%0 1000001 ; Place cursor CALL Set_Cursor ; CALL Input_Number ; Get HL := 0 .. 999 RET C ; Fail CALL Clear_LCD ; Reset and clear it CALL Get_Profile_Ptr ; Make it a ptr JR NC dwS_1 ; Valid LD HL,sSave_IP ; Invalid number CALL Print_Str ; CALL Get_A_Key ; Pause JR dwSave ; Try again dwS_1 PUSH HL ; Save ptr POP IX ; LD A,(HL) ; Valid ? AND (IX+1) ; (FFFF = not used) INC A ; = FFFF ? JR Z dwS_Save ; Yes, save profile ; Is the checksum valid ? CALL Calc_Checksum ; Is it valid ? JR NZ dwS_Save ; No, save it ; Already used, check CALL Clear_LCD ; Reset and clear it LD HL,sSave_PE ; Profile exists CALL Print_Str ; CALL Get_A_Key ; Pause CP "S" ; Save ? RET NZ ; No, don't save dwS_Save PUSH IX ; Get ptr POP DE ; LD HL,Motor_Speed ; Calc checksum CALL Calc_Checksum ; LD (Check_Byte),A ; Store it LD HL,Motor_Speed ; Get profile data LD BC,16 ; Length LDIR ; Save it CALL Clear_LCD ; Reset and clear it LD HL,sSave_PS ; Profile stored CALL Print_Str ; LD B,30 ; About 1 second Read_Key_Delay PUSH BC ; Save cnt CALL Read_ADC ; Get inputs CALL Drive_Outputs ; Drive the triacs CALL ReadKey ; If anything pressed, then drop out JR C RKD_Exit ; POP BC ; Pause DJNZ Read_Key_Delay ; RET ; Done RKD_Exit POP BC ; Done RET ; ; HL points at 10 bytes, calc checksum Calc_Checksum PUSH HL ; Save PUSH BC ; LD B,10 ; Count XOR A ; Zero sum CC_Lp ADD A,(HL) ; Accumulate it INC HL ; Step ptr DJNZ CC_Lp ; Loop CP (HL) ; Same as current checksum ? POP BC ; Restore POP HL ; RET ; Done ; Given a profile number in HL return a ptr in HL Get_Profile_Ptr LD A,L ; 0 ? OR H ; JR Z GPP_0 ; Yes, skip DEC HL ; Start at 1 LD BC,nProfiles ; In range ? OR A ; SBC HL,BC ; CCF ; RET C ; Fail ADD HL,BC ; Restore ADD HL,HL ; * 16 bytes ADD HL,HL ; ADD HL,HL ; ADD HL,HL ; LD BC,Profiles ; Add base addr ADD HL,BC ; RET ; Done ; Setup default GPP_0 LD HL,Default_Profile ; 000 OR A ; Done RET ; Input_Number LD HL,Buffer ; Read string LD B,3 ; Max. 3 chars CALL Get_String ; Read it in RET C ; Del back LD DE,Buffer ; Point at string CALL Read_Number ; Get a number RET ; Read_Number CALL Digit ; Valid ? RET C ; No, error LD L,A ; Into acc LD H,0 ; RN_Lp CALL Digit ; Get no. CCF ; Not an error if not a digit RET NC ; But done ADD HL,HL ; * 2 LD B,H ; * 2 LD C,L ; ADD HL,HL ; ADD HL,HL ; * 8 ADD HL,BC ; * 10 LD C,A ; Current digit LD B,0 ; ADD HL,BC ; Add it JR RN_Lp ; Loop Digit LD A,(DE) ; Get char SUB "0" ; Align RET C ; Not a digit CP 10 ; In range CCF ; RET C ; Not a digit INC DE ; Skip digit RET ; Done Get_String LD C,0 ; Number of characters GS_Lp LD (HL),0 ; Terminate buffer PUSH HL ; Save ptr PUSH BC ; Save lengths CALL Cursor_On ; Show cursor CALL Get_A_Key ; Giz a key CALL Cursor_Off ; Hide it again POP BC ; Get length POP HL ; Get ptr CP #0D ; End ? RET Z ; Yes, done CP "E" ; End ? RET Z ; Yes, done CP #08 ; Delete ? JR NZ GS_1 ; No, show it INC C ; Are we at the start ? DEC C ; JR Z GS_Del_Back ; Yes, exit CALL Get_Cursor ; Step back DEC A ; CALL Set_Cursor ; PUSH AF ; Save X LD A," " ; Kill char CALL Print ; POP AF ; X CALL Set_Cursor ; Move cursor DEC HL ; Step back INC B ; Another char DEC C ; One less JR GS_Lp ; Loop GS_Del_Back LD (HL),0 ; Kill buffer SCF ; Fail RET ; Done GS_1 CP "0" ; Numeric ? JR C GS_Lp ; No CP "9"+1 ; JR NC GS_Lp ; No INC B ; Buffer full ? DEC B ; JR Z GS_Lp ; Loop LD (HL),A ; Save it INC HL ; Step ptr DEC B ; One more char INC C ; One more CALL Print ; Show char JR GS_Lp ; Loop dwMotorSpeed CALL Clear_LCD ; Clear LCD LD HL,(Motor_Speed) ; Get motor speed LD (dwMS_MS),HL ; Save it LD HL,sMotorSpeed ; Show this CALL Print_Str ; LD DE,0 ; Don't change JR dwMS_S ; Show speed dwMS_Lp_TO LD BC,dwMotor_Time ; How long to wait dwMS_Lp PUSH BC ; Save time-out CALL ReadKey ; Get a key PUSH AF ; Save char CALL Read_ADC ; Get inputs CALL Drive_Outputs ; Drive the triacs LD DE,1 ; Inc LD HL,Key_Data+knInc ; "UP KEY" BIT 5,(HL) ; Inc motor speed JR NZ dwMS_S_1 ; LD DE,-1 ; Dec LD HL,Key_Data+knDec ; "DOWN KEY" BIT 5,(HL) ; Dec motor speed JR NZ dwMS_S_1 ; No POP AF ; Restore char POP BC ; Restore time-out JR C dwMS_Key ; Summat pressed CPI ; Loop JP V dwMS_Lp ; JR dwMS_Cancel ; Time-out dwMS_Key CP #0D ; Accept ? RET Z ; Yes, done CP "R" ; Motor speed ? RET Z ; Yes, done CP #08 ; Cancel ? JR NZ dwMS_Lp_TO ; No, loop dwMS_Cancel LD HL,(dwMS_MS) ; Restore old speed LD (Motor_Speed),HL ; RET ; Done dwMS_S_1 POP AF ; Lose char POP BC ; Time-out dwMS_S LD HL,(Motor_Speed) ; Get speed ADD HL,DE ; Step it LD DE,101 ; No more than 100 OR A ; SBC HL,DE ; JR NC dwMS_S_Clip ; Out of range ADD HL,DE ; Restore LD DE,1 ; No less than 1 OR A ; SBC HL,DE ; JR C dwMS_S_Clip ; Out of range ADD HL,DE ; Restore LD (Motor_Speed),HL ; Save speed dwMS_S_Clip PUSH BC ; Save time-out LD HL,(Motor_Speed) ; Show it CALL Show_Motor_Speeds ; LD A,%0 0011000 ; Off screen CALL Set_Cursor ; POP BC ; Restore time-out JR dwMS_Lp_TO ; Loop ; Write motor speeds onto the LCD Show_Motor_Speeds LD A,%0 0001101 ; Home + 14 CALL Set_Cursor ; PUSH HL ; Save 1 .. 100 CALL Write_Number ; Show the speed POP HL ; Restore LD DE,HL ; Copy ADD HL,HL ; * 7 ADD HL,HL ; ADD HL,HL ; OR A ; SBC HL,DE ; LD DE,Conv_Table ; Look-up table ADD HL,DE ; LD A,%0 0101000 ; Point at it CALL Set_Cursor ; LD B,3 ; Show the mm/minute CALL Print_Norm_L ; LD A,%0 1010001 ; Point at it CALL Set_Cursor ; LD B,2 ; Show the inch/minute CALL Print_Norm_L ; LD A,%0 1010100 ; Point at it CALL Set_Cursor ; LD B,2 ; Show the inch/minute CALL Print_Norm_L ; RET ; Done Get_A_Key_Pots CALL ReadKey ; Scan the keyboard PUSH AF ; Save char CALL Read_ADC ; Read inputs LD HL,cADC_4 ; Copy pots to demand LD DE,Demand_0 ; LD BC,4*2 ; LDIR ; CALL Drive_Outputs ; Drive the triacs CALL Fail_Messages ; Display flash CALL Show_Volts ; Show them POP AF ; Get char JR NC Get_A_Key_Pots ; None pressed RET ; Done Get_A_Key_Auto CALL ReadKey ; Scan the keyboard PUSH AF ; Save char CALL Read_ADC ; Get inputs CALL Drive_Outputs ; Drive the triacs CALL Fail_Messages ; Display flash CALL Show_Volts_Actual ; Show them POP AF ; Restore char JR NC Get_A_Key_Auto ; None pressed RET ; Done Get_A_Key CALL ReadKey ; Scan the keyboard PUSH AF ; Save char CALL Read_ADC ; Get inputs CALL Drive_Outputs ; Drive the triacs POP AF ; Restore char JR NC Get_A_Key ; None pressed RET ; Done Read_A_Key CALL ReadKey ; Scan the keyboard PUSH AF ; Save char CALL Read_ADC ; Get inputs POP AF ; Restore char JR NC Read_A_Key ; None pressed RET ; Done ; Flashes fail message on display if required Fail_Messages LD A,(Error_Number) ; Any errors ? OR A ; RET Z ; No, ignore LD A,(Flash_Mess_Rate) ; Flash it ? DEC A ; LD (Flash_Mess_Rate),A ; RET NZ ; Done LD A,FMR_Rate ; Flash rate LD (Flash_Mess_Rate),A ; CALL Get_Cursor ; Save cursor PUSH AF ; LD HL,Mess_Buffer ; Save display CALL Read_LCD_Str ; CALL Init_LCD ; Reset LCD LD A,(Error_Number) ; Get the string AND %111 ; 1,2,3,4,5,6,7 ADD A,A ; * 2 ADD A,EM_Tab & #FF ; LD L,A ; ADC A,EM_Tab / 256 ; SUB L ; LD H,A ; LD A,(HL) ; Get message text INC HL ; LD H,(HL) ; LD L,A ; CALL Print_Str ; LD HL,3000 ; Pause FM_Delay CALL ReadKey ; Get any keys JR NC FM_1 ; None CP #08 ; Cancel ? JR Z FM_Cancel ; Yes FMD_Lp CALL Get_A_Key ; Get the next key CP #08 ; Cancel ? JR NZ FM_Exit ; No FM_Cancel CALL Init_Errors ; Kill this message JR FM_Exit ; Done FM_1 DEC HL ; Wait LD A,L ; Loop OR H ; JR NZ FM_Delay ; FM_Exit CALL Init_LCD ; Clear LD HL,Mess_Buffer ; Restore CALL Send_LCD_Str ; POP AF ; Restore cursor CALL Set_Cursor ; RET ; Done ; Calc triacs and relays ; Check if we are using a relay too often, for a constant demand ; since this is a sign of triac failure ; Flag that the triac states are valid Drive_Outputs LD A,(Triacs) ; Get old state LD B,A ; Save RLCA ; Align RLCA ; RLCA ; RLCA ; OR B ; Relays := Relays ! Triacs OR %0000 1111 ; Assume triacs ON, preserve relays LD B,A ; Save state LD HL,(cADC_0) ; Actual LD DE,(Demand_0) ; Demand OR A ; Compare SBC HL,DE ; JR C DO_1 ; Lesser, triac On, relay On ; Greater, triac off RES 0,B ; Kill triac LD DE,-9 ; 10 degree difference ADD HL,DE ; JR NC DO_1 ; Less than 10 degrees, relay hold RES 4,B ; Kill relay DO_1 LD HL,(cADC_1) ; Actual LD DE,(Demand_1) ; Demand OR A ; Compare SBC HL,DE ; JR C DO_2 ; Lesser, triac On, relay On ; Greater, triac off RES 1,B ; Kill triac LD DE,-9 ; 10 degree difference ADD HL,DE ; JR NC DO_2 ; Less than 10 degrees, relay hold RES 5,B ; Kill relay DO_2 LD HL,(cADC_2) ; Actual LD DE,(Demand_2) ; Demand OR A ; Compare SBC HL,DE ; JR C DO_3 ; Lesser, triac On, relay On ; Greater, triac off RES 2,B ; Kill triac LD DE,-9 ; 10 degree difference ADD HL,DE ; JR NC DO_3 ; Less than 10 degrees, relay hold RES 6,B ; Kill relay DO_3 LD HL,(cADC_3) ; Actual LD DE,(Demand_3) ; Demand OR A ; Compare SBC HL,DE ; JR C DO_4 ; Lesser, triac On, relay On ; Greater, triac off RES 3,B ; Kill triac LD DE,-9 ; 10 degree difference ADD HL,DE ; JR NC DO_4 ; Less than 10 degrees, relay hold RES 7,B ; Kill relay DO_4 LD A,B ; Get bits LD (Triacs),A ; Save it CALL Triacs_Valid ; The value is valid ; Now test for relay usage (don't, it doesn't work . .) ; CALL Check_Relay_Use ; Check for shorted triac ; Now drive the trffic lights CALL Drive_Lights ; Drive them LD B,8 ; Debounce fail lines DO_TTF CALL Get_Therm_Fail ; Test thermos OR A ; Any failed RET Z ; No DJNZ DO_TTF ; Loop ; A thermocouple has failed, show which and stop CALL Get_Bit_Number ; Convert to 0 .. 3 ADD A,A ; * 2 0.. 6 ADD A,Therm_Fail_Tab & #FF ; Look up string LD L,A ; ADC A,Therm_Fail_Tab / 256 ; SUB L ; LD H,A ; LD A,(HL) ; Get nth string INC HL ; LD H,(HL) ; LD L,A ; PUSH HL ; Save string ptr CALL Init_LCD ; Clear the LCD POP HL ; Show failure string CALL Print_Str ; JP Error_STOP ; HALT ; Reset the relay fail counts, etc Init_Relay_Use LD IX,CRU_Data_0 ; Data for triac counts LD B,3 ; Check 3 zones IRU_Lp LD (IX),#FF ; Illegal temerature LD (IX+1),#FF ; LD (IX+2),#0 ; No bit set LD (IX+3),CRU_iCount ; Reset count LD DE,4 ; Step ptr ADD IX,DE ; DJNZ IRU_Lp ; Loop RET ; Done ; Check if relays are being overused Check_Relay_Use PUSH IX ; Save regs ; First see if 22 minutes have elapsed LD A,(CRU_Period_Ends) ; Check flag OR A ; JR Z CRU_DoIt ; No, check them ; They have, allow one fail for each triac XOR A ; Clear flag LD (CRU_Period_Ends),A ; LD IX,CRU_Data_0 ; Point at data LD B,3 ; nTriacs (not subzone) LD DE,4 ; Length of data CRU_DecCnt LD A,(IX+3) ; Get the number remaining CP CRU_iCount ; JR Z CRU_DC_Next ; None used, ignore INC (IX+3) ; Allow one more CRU_DC_Next ADD IX,DE ; Step ptr DJNZ CRU_DecCnt ; Loop ; Now check for failures CRU_DoIt LD HL,(Demand_0) ; Demand Zone 0 LD A,%0001 0000 ; Bit mask LD IX,CRU_Data_0 ; Point at data area LD B,1 ; Error message no CALL CRU_Test ; Test this one LD HL,(Demand_1) ; Demand Zone 1 LD A,%0010 0000 ; Bit mask LD IX,CRU_Data_1 ; Point at data area LD B,2 ; Error message no CALL CRU_Test ; Test this one LD HL,(Demand_2) ; Demand Zone 2 LD A,%0100 0000 ; Bit mask LD IX,CRU_Data_2 ; Point at data area LD B,3 ; Error message no CALL CRU_Test ; Test this one POP IX ; Restore RET ; Done CRU_Test PUSH HL ; Save new temperature LD DE,(IX) ; Get the last demanded temp OR A ; Calc difference SBC HL,DE ; JR Z CRUT_1 ; Same temp JR NC CRUT_Pos ; Higher EX DE,HL ; Negate it LD HL,0 ; OR A ; SBC HL,DE ; CRUT_Pos LD DE,2 ; Within 1 OR A ; SBC HL,DE ; JR NC CRUT_New ; Out of range, reset count ; Demand hasn't changed CRUT_1 POP HL ; Restore new temp (and ignore) LD E,A ; Save mask LD A,(Triacs) ; Get current state AND E ; Mask out other bits CP (IX+2) ; Same as previous state ? RET Z ; Yes, done LD (IX+2),A ; Save new relay state OR A ; Now off ? RET NZ ; No, ignore DEC (IX+3) ; One more change RET NZ ; Ok, not maxm. yet LD A,B ; Giz error message LD (Error_Number),A ; Show fail PUSH HL ; Stack new temp CRUT_New POP HL ; Get new temp LD (IX),HL ; Store new temp LD (IX+3),CRU_iCount ; Eight changes RET ; Done Send_LCD_Str LD A,(HL) ; Get char OR A ; RET Z ; End CALL Send_LCD_D ; Show it INC HL ; Step ptr JR Send_LCD_Str ; Loop Read_LCD_Str CALL Get_Cursor ; Save it PUSH AF ; XOR A ; Rewind cursor CALL Set_Cursor ; LD B,80 ; Read them all RLS_Lp CALL Wait_LCD ; Not busy ? IN A,(LcdD) ; Get data LD (HL),A ; Store it INC HL ; DJNZ RLS_Lp ; Loop LD (HL),0 ; Terminate string POP AF ; Restore cursor JP Set_Cursor ; Print CALL Send_LCD_D ; Print it PUSH AF ; Save LD A,(Cursor) ; Step cursor INC A ; LD (Cursor),A ; POP AF ; Restore RET ; Send_LCD_D CALL Wait_LCD ; Wait till not busy OUT (LcdD),A ; Send it RET ; Done Send_LCD_K CALL Wait_LCD ; Wait till not busy OUT (LcdK),A ; Send it RET ; Done Get_Cursor LD A,(Cursor) ; Get it RET ; Done Set_Cursor CALL Wait_LCD ; Not busy OR %1 0000000 ; Create command OUT (LcdK),A ; Set it AND %01111111 ; LD (Cursor),A ; Save it PUSH IX ; Delay POP IX ; RET ; Done Wait_LCD PUSH AF ; Save data WLCD_Lp IN A,(LcdK) ; Bit 7 = busy RLCA ; Into carry JR C WLCD_Lp ; Wait POP AF ; Done RET ; Show_Pro_Volts LD A,%0 0001000 ; Home CALL Set_Cursor ; LD IY,Demand_0 ; Show the demands LD B,4 ; JP SV_Lp ; Do first 5 Show_Virt_Volts LD A,%0 0001000 ; Home CALL Set_Cursor ; PUSH IX ; Point at them POP IY ; INC IY ; Skip motor speed INC IY ; LD B,4 ; JP SV_Lp ; Do first 4 Show_Volts LD A,%0 0001000 ; Home CALL Set_Cursor ; LD IY,cADC_4 ; Show them all LD B,4 ; CALL SV_Lp ; Do first 4 Show_Volts_Actual LD A,%0 1001000 ; Next line CALL Set_Cursor ; LD IY,cADC_0 ; Show them all LD B,4 ; SV_Lp DEC B ; One less than loop JR Z SV_Last ; Show last one SV_Lp1 PUSH BC ; Save count LD HL,(IY) ; Get it CALL Write_Voltage ; Show it LD A," " ; Space CALL Print ; CALL Print ; CALL Print ; CALL Print ; POP BC ; INC IY ; INC IY ; DJNZ SV_Lp1 ; Loop SV_Last LD HL,(IY) ; Get last CALL Write_Voltage ; Show it RET ; Done WV_High LD HL,sTooHigh ; "***'" JP Print_Str ; WV_Low LD HL,sTooLow ; "LOW'" JP Print_Str ; Write_Voltage LD DE,601 ; Valid ? OR A ; SBC HL,DE ; JR NC WV_High ; No, too high ADD HL,DE ; Restore LD DE,50 ; Valid ? OR A ; SBC HL,DE ; JR C WV_Low ; No, too low ADD HL,DE ; Restore CALL Write_Number ; 000 .. 999 LD A,cDeg ; Add degree symbol CALL Print ; LD A,"C" ; Centigrade JP Print ; WN_High LD HL,sNTooHigh ; "***" JP Print_Str ; Write_Number LD DE,1000 ; Valid ? OR A ; SBC HL,DE ; JR NC WN_High ; No, too high ADD HL,DE ; Restore LD C," " ; Suppress leading zeros LD DE,-100 ; 3 digit decimal CALL Write1 LD DE,-10 ; CALL Write1 ; LD A,L ; ADD A,"0" ; JP Print ; Write1 XOR A Write2 INC A ADD HL,DE JR C,Write2 SBC HL,DE ADD A,#2F CP "0" ; 0 ? JR NZ Write3 ; No LD A,C ; Print C instead JP Print ; Write3 LD C,"0" ; Now "0" JP Print ; ; ADC 0 .. 3 are the thermocouples ; ADC 4 .. 7 are the pots Read_ADC CALL Clear_Integrator ; Start from zero LD HL,(Motor_Speed) ; Calc motor voltage LD DE,HL ; ADD HL,HL ; * 2 ADD HL,HL ; * 4 ADD HL,DE ; * 5 LD DE,Motor_Min ; Offset ADD HL,DE ; LD (Motor_Voltage),HL ; Save voltage LD HL,cADC_0 ; Preset to HIGH (1285) LD DE,cADC_0+1 ; LD BC,8*2-1 ; LD (HL),#05 ; LDIR ; CALL Int_Wait ; Lock to interrupts LD BC,1 ; Initial count LD L,0 ; Initial bits RADC_Lp LD A,(ADC_0) ; Read inputs LD E,A ; LD A,L ; Bottom bits OR E ; Mask INC A ; = FF ? JR NZ RADC_Low ; No, got one RADC_Low_D INC BC ; Hack motor speed -1 LD A,(Motor_Voltage) ; Giz the motor voltage CP C ; Low equal ? JR NZ RADC_NotMot ; Not the right voltage LD A,(Motor_Voltage+1) ; Giz the motor voltage CP B ; Low equal ? JR NZ RADC_NotMot ; Not the right voltage LD A,(bLatch_0) ; Get the current value AND %1111 0 1 1 1 ; Sample voltage LD (Latch_0),A ; RADC_NotMot LD A,C ; Pot voltage CP #59 ; (600) JR NZ RADC_NotDAC ; No LD A,B ; Pot voltage CP #02 ; (601) JR NZ RADC_NotDAC ; No LD A,(bLatch_0) ; Get the current value AND %1111 1 0 1 1 ; Sample voltage LD (Latch_0),A ; PUSH IX ; Aperture time POP IX ; RADC_NotDAC DEC BC ; Hack over LD A,(bLatch_0) ; Get the current value AND %1111 1 1 0 1 ; Step current = ON DI ; Kill the interrupts LD (Latch_0),A ; PUSH IX ; Pulse it POP IX ; PUSH IX ; Pulse it POP IX ; OR %0000 0 0 1 0 ; Step current = OFF LD (Latch_0),A ; EI ; Allow interrupts again INC C ; Inc count JR NZ RADC_Lp ; Loop INC B ; Inc count LD A,B ; End ? CP #4 ; Maxm. count JR NZ RADC_Lp ; No, loop RADC_Done LD HL,(cADC_4) ; Convert to 300 .. 600 CALL Pot_Conv_1 ; LD (cADC_4),HL ; LD HL,(cADC_5) ; CALL Pot_Conv_1 ; LD (cADC_5),HL ; LD HL,(cADC_6) ; CALL Pot_Conv_1 ; LD (cADC_6),HL ; LD HL,(cADC_7) ; This is now the same CALL Pot_Conv_1 ; LD (cADC_7),HL ; RET ; Done RADC_Low DEC A ; Dec again RADC_L_D OR L ; Mask new CP #FF ; Done all ? JP Z RADC_Low_D ; Yes, return BIT 0,A ; This one ? JR Z RADC_L_0 ; Yes BIT 1,A ; This one ? JR Z RADC_L_1 ; Yes BIT 2,A ; This one ? JR Z RADC_L_2 ; Yes BIT 3,A ; This one ? JR Z RADC_L_3 ; Yes BIT 4,A ; This one ? JR Z RADC_L_4 ; Yes BIT 5,A ; This one ? JR Z RADC_L_5 ; Yes BIT 6,A ; This one ? JR Z RADC_L_6 ; Yes RADC_L_7 SET 7,L ; Mask it out LD (cADC_7),BC ; Save count JR RADC_L_D ; Done RADC_L_6 SET 6,L ; Mask it out LD (cADC_6),BC ; Save count JR RADC_L_D ; Done RADC_L_5 SET 5,L ; Mask it out LD (cADC_5),BC ; Save count JR RADC_L_D ; Done RADC_L_4 SET 4,L ; Mask it out LD (cADC_4),BC ; Save count JR RADC_L_D ; Done RADC_L_3 SET 3,L ; Mask it out LD (cADC_3),BC ; Save count JR RADC_L_D ; Done RADC_L_2 SET 2,L ; Mask it out LD (cADC_2),BC ; Save count JR RADC_L_D ; Done RADC_L_1 SET 1,L ; Mask it out LD (cADC_1),BC ; Save count JR RADC_L_D ; Done RADC_L_0 SET 0,L ; Mask it out LD (cADC_0),BC ; Save count JR RADC_L_D ; Done Pot_Conv_1 SRA H ; / 2 RR L ; LD BC,300 ; Base ADD HL,BC ; LD BC,600 ; Maxm OR A ; Check SBC HL,BC ; JR NC PC_1_Clip ; Clip it to 600 ADD HL,BC ; RET ; Done PC_1_Clip LD HL,600 ; Maxm RET ; Pot_Conv_2 LD BC,HL ; * 1 ADD HL,HL ; * 2 ADD HL,HL ; * 4 ADD HL,BC ; * 5 SRA H ; /2 RR L ; SRA H ; /4 RR L ; CALL Div_3 ; Divide by 3 LD BC,100 ; Base ADD HL,BC ; LD BC,350 ; Maxm OR A ; Check SBC HL,BC ; JR NC PC_2_Clip ; Clip it to 350 ADD HL,BC ; RET ; Done PC_2_Clip LD HL,350 ; Maxm RET ; Div_3 LD DE,#300 ; 3 scaled LD A,9 ; Loop cnt LD BC,0 ; Result D3_Lp OR A ; Try it SBC HL,DE ; JR NC D3_1 ; Yes ADD HL,DE ; Restore SCF ; Clear asserted D3_1 CCF ; Other state RL C ; Accumulate RL B SRA D ; Shift divisor RR E ; DEC A ; Loop JR NZ D3_Lp ; LD HL,BC ; Save result RET ; Done Int_Wait LD A,(Int_Cnt) ; Get first value LD C,A ; LD HL,0 ; Maxm delay value IW_Lp LD A,(Int_Cnt) ; Changed ? CP C ; RET NZ ; Yes, done DEC HL ; time-out LD A,L ; Done ? OR H ; JR NZ IW_Lp ; No, loop ; Int has failed, report error DI ; Reset it JP 0 ; ; Setup the traffic lights Reset_Lights LD HL,Demand_0 ; Copy the demand temps LD DE,Light_Dem_0 ; LD BC,4 * 2 ; This many LDIR ; Copy them LD A,%0 1 0 ; Amber LD (Lights),A ; Force it ; Show it Show_Lights PUSH AF ; Save LD A,(Lights) ; Get it CPL ; Invert it AND %1 1 1 ; Clip OUT (PioAD),A ; Drive them POP AF ; Restore RET ; Done ; Called in drive loop Drive_Lights CALL Check_Lights_Dem ; Has the demand changed ? CALL Check_Lights_Act ; Drive the lights RET ; Done ; Check to see if actual temps are in range Check_Lights_Act PUSH IX ; Save PUSH HL ; PUSH DE ; PUSH BC ; LD C,0 ; Clear the flags ; Reflow zone LD HL,(cADC_0) ; RF LD DE,(Light_Dem_0) ; Demand LD IX,Limit_RF_Above ; Above,Below CALL CLA_Calc ; Get the correct light for this zone ; Preheat 1 LD HL,(cADC_1) ; RF LD DE,(Light_Dem_1) ; Demand LD IX,Limit_P2_Above ; Above,Below CALL CLA_Calc ; Get the correct light for this zone ; Preheat 2 LD HL,(cADC_2) ; RF LD DE,(Light_Dem_2) ; Demand LD IX,Limit_P1_Above ; Above,Below CALL CLA_Calc ; Get the correct light for this zone ; Sub zone LD HL,(cADC_3) ; RF LD DE,(Light_Dem_3) ; Demand LD IX,Limit_SZ_Above ; Above,Below CALL CLA_Calc ; Get the correct light for this zone ; Now examine the flags BIT 2,C ; Any over ranges ? JR NZ CLA_RED ; Yes, skip BIT 0,C ; Any Out_Of_Ranges ? JR NZ CLA_OUT ; Yes, skip BIT 1,C ; Any don't changes ? JR NZ CLA_X ; Yes, skip ; We are all green here LD A,%1 0 0 ; Green CLA_Set LD (Lights),A ; CALL Show_Lights ; Show it ; Exit CLA_X POP BC ; Restore POP DE ; POP HL ; POP IX ; RET ; Done ; We have some out of ranges CLA_OUT LD A,(Lights) ; Are we in amber ? CP %0 1 0 ; Amber JR Z CLA_Set ; Yes, stay in amber ; No. go to red CLA_RED LD A,%0 0 1 ; Red JR CLA_Set ; ; Given HL = Temp, DE = Base, (IX) = Above and (IX+2) = below ; return C = flags Bit 0 = Out of range, Bit 1 = Exactly on edge of range CLA_Calc OR A ; Get the difference from demand SBC HL,DE ; JP M CLA_Below ; Are we below the temp ? ; We are above the demand temp. check how far LD DE,(IX) ; Get above range OR A ; In the acceptable range ? SBC HL,DE ; RET C ; Yes JR Z CLAC_Edge ; Right on the edge ; We are out of range SET 2,C ; Flag Over_Range SET 0,C ; Also set Out_Of_Range RET ; Done ; We are right on the edge of the range CLAC_Edge SET 1,C ; Flag right on edge RET ; Done ; We are below the required temp. calc ABS CLA_Below EX DE,HL ; ABS LD HL,0 ; OR A ; SBC HL,DE ; ; HL = Pos. difference LD DE,(IX+2) ; Below range OR A ; In the acceptable range ? SBC HL,DE ; RET C ; Yes JR Z CLAC_Edge ; Right on the edge ; We are out of range SET 0,C ; Flag out of range RET ; Done ; Check to see if the demand temperatures have changed (much) Check_Lights_Dem PUSH IX ; Save PUSH IY ; PUSH HL ; PUSH DE ; PUSH BC ; ; Examine them for any large changes LD IX,Demand_0 ; Current LD IY,Light_Dem_0 ; Lights old value LD B,4 ; Number CLD_Lp LD HL,(IX) ; Current LD DE,(IY) ; Old OR A ; Get the difference SBC HL,DE ; JR Z CLD_Same ; No diff. JP P CLD_1 ; Diff > 0 EX DE,HL ; NEG LD HL,0 ; OR A ; SBC HL,DE ; ; HL = |diff| CLD_1 LD DE,L_D_Range ; Is this in range ? OR A ; SBC HL,DE ; JR Z CLD_Same ; Skip JP M CLD_Same ; It is OK ; This is an alteration CALL Reset_Lights ; Things have changed, exit JR CLD_X ; Leave ; No change, next CLD_Same INC IX ; Skip INC IX ; INC IY ; INC IY ; DJNZ CLD_Lp ; Loop ; Done CLD_X POP BC ; Restore POP DE ; POP HL ; POP IY ; POP IX ; RET ; Done ; Setup the hardware Init_Ports LD A,%0 000 0011 ; DI OUT (PioAK),A ; Do it to ensure synchronisation OUT (PioAK),A ; OUT (PioAK),A ; OUT (PioBK),A ; OUT (PioBK),A ; OUT (PioBK),A ; ; This next bit is called after the interrupts are enabled Init_Ports_1 LD A,#FF ; Mode 3 OUT (PioAK),A ; LD A,%11111 0 0 0 ; Light driving bits OUT (PioAK),A ; LD A,#FF ; Mode 3 OUT (PioBK),A ; LD A,%0111 1110 ; OUT (PioBK),A ; LD A,%1111 1 1 1 1 ; Default = all off LD (bLatch_0),A ; LD A,%0 0 0 0 0 0 0 0 ; Triacs / Relays off LD (Triacs),A ; LD (Triac_Port),A ; RET ; Done Clear_Integrator PUSH AF ; Save acc LD A,(bLatch_0) ; Get defaults AND %1111 1 1 1 0 ; Clear int LD (Latch_0),A ; LD A,255 ; This delay CI_Wait DEC A ; Wait NOP ; JR NZ CI_Wait ; LD A,(bLatch_0) ; Get defaults OR %0000 0 0 0 1 ; Clear int LD (Latch_0),A ; LD A,25 ; This delay CI_Wait1 DEC A ; Wait NOP ; JR NZ CI_Wait1 ; POP AF ; Done RET ; Print_Str LD A,L ; Decrypt XOR H ; AND enMASK ; Mask addr XOR (HL) ; XOR with data SUB enADD ; SUB Add byte XOR enXOR ; XOR Xor byte RET Z ; Done CALL Send_LCD_D ; Show it INC HL ; Step ptr JR Print_Str ; Loop Print_Str_L LD A,L ; Decrypt XOR H ; AND enMASK ; Mask addr XOR (HL) ; XOR with data SUB enADD ; SUB Add byte XOR enXOR ; XOR Xor byte CALL Send_LCD_D ; Show it INC HL ; Step ptr DJNZ Print_Str_L ; Loop RET ; Done ; Show a non encrypted string (HL) of length B Print_Norm_L LD A,(HL) ; Get char INC HL ; Step ptr CALL Send_LCD_D ; Show it DJNZ Print_Norm_L ; Loop RET ; Done Init_Keys LD HL,Key_Data ; Clear counts LD B,20 ; IK_Lp LD (HL),#10 ; Kill it INC HL ; DJNZ IK_Lp ; Loop LD A,%1 0 000000 ; Non_existant key LD (Key_Data+knNC),A ; Kill extra key RET ; Done ReadKey PUSH IX ; Save reg RK_LP CALL ScanKeys ; Get a scan-code OR A ; Found JR Z RK_Done ; None pressed PUSH HL ; Save regs PUSH DE ; PUSH IX ; Get ptr to key POP HL ; LD DE,Key_Data ; Base OR A ; SBC HL,DE ; Calc offset LD DE,Key_Codes ; Look-up value ADD HL,DE ; LD A,(HL) ; Code POP DE ; Restore POP HL ; SCF ; Return char RK_Done POP IX ; Restore RET ; ScanKeys PUSH HL ; Save regs PUSH DE ; PUSH BC ; LD HL,Key_Data ; De-bounce data LD E,0 ; No key pressed LD C,%000 0 0000 ; Output to drive SK_Lp LD A,Latch_0_Def ; Giz defaults OR C ; Combine LD (Latch_0),A ; Select it PUSH IX ; Small delay POP IX ; LD A,(Key_R) ; Get data LD D,A ; Save it LD B,5 ; Do five codes SK_Lp2 RR D ; Do one JR NC SK_Press ; Pressed LD A,(HL) ; Get count BIT 7,A ; Illegal key ? JR NZ SK_X2 ; Yes, ignore it AND %000000 11 ; Test if 0 JR NZ SK_NP1 ; No, dec count LD A,(HL) ; Kill count and pressed flag AND %11 0 0 0000 ; LD (HL),A ; Kill flag JP SK_X2 ; Next SK_NP1 DEC (HL) ; Lower count JP SK_X2 ; Get next SK_Press LD A,(HL) ; Get debounce count BIT 7,A ; Illegal key ? JR NZ SK_X2 ; Yes, ignore it INC A ; Step count BIT 0,A ; Max JR NZ SK_P1 ; Yes, don't step further LD (HL),A ; Save JP SK_X2 ; Next SK_P1 SET 5,(HL) ; Assert pressed flag BIT 4,A ; Already sent ? JR NZ SK_X2 ; Yes, ignore INC E ; Key found already ? DEC E ; JR NZ SK_X2 ; Yes, ignore SET 4,(HL) ; Assert sent flag LD E,1 ; Flag it PUSH HL ; Save ptr POP IX ; SK_X2 INC HL ; Next key DJNZ SK_Lp2 ; Loop LD A,%001 00000 ; Select next output ADD A,C ; LD C,A ; CP %100 00000 ; All done ? JR C SK_Lp ; No LD A,E ; Get found flag POP BC ; Restore regs POP DE ; POP HL ; RET ; Done Power_Up_Delay LD A,%1 1 1 ; Show all of them LD (Lights),A ; CALL Show_Lights ; LD B,0 ; Wait for reset cap. to charge PUD_Lp LD C,0 ; Inner loop cnt PUD_Lp1 PUSH IX ; Delay POP IX ; PUSH IX ; POP IX ; DEC C ; Loop JR NZ PUD_Lp1 ; DJNZ PUD_Lp ; Longer delay CALL Test_CHK ; Valid ROM ? RET Z ; No, fail LD HL,sEPROM_Fail ; Dropped bits Error_HALT PUSH HL ; Save ptr to string CALL Init_LCD ; Clear the display etc POP HL ; Restore CALL Print_Str ; Show it Error_STOP LD SP,RamBott ; Reset the stack CALL Init_Ports_1 ; Reset the machine CALL Init_Keys ; Reset the keyboard scan LD A,%0 0 1 ; RED LD (Lights),A ; CALL Show_Lights ; ES_Lp CALL Read_A_Key ; Get a key CP #08 ; Cancel ? JR NZ ES_Lp ; No, loop JP Start ; Try again ; Test checksum Test_CHK PUSH HL ; Save PUSH DE ; PUSH BC ; LD HL,Base ; Point to first LD BC,Check_End-Base ; Length LD DE,0 ; Zero chks Test_Lp LD A,(HL) ; Xor XOR E ; LD E,A ; LD A,(HL) ; Add ADD A,D ; LD D,A ; CPI ; Loop JP V Test_Lp ; LD A,D ; Test for 0 OR E ; POP BC ; Restore POP DE ; POP HL ; RET Z ; Valid SCF ; Fail RET ; ; A := Fail flags (1=Fail) Get_Therm_Fail IN A,(PioBD) ; Bits 6..3 RRCA ; Align RRCA ; RRCA ; CPL ; Invert states AND %0000 1 1 1 1 ; Mask out fail bits RET ; Done ; Convert first set bit in A to number in A (0..3) Get_Bit_Number OR A ; Fail if none RET Z ; LD B,A ; Into B XOR A ; Start GBN_Lp RR B ; Test first bit RET C ; Set, done INC A ; Step bit no. JR GBN_Lp ; Loop Init_Errors XOR A ; No errors yet LD (Error_Number),A ; LD A,1 ; Error flash rate LD (Flash_Mess_Rate),A ; RET ; Done Init_Ints CALL Init_Ints_I ; Set up the PIO CALL Init_Ints_I ; make sure it is set up CALL Init_Ints_I ; make damn sure . . LD HL,0 ; Clear timer LD (Int_Cnt),HL ; EI ; Go RET ; Done Init_Ints_I DI ; Kill them IM 2 ; Set mode LD A,Int_Vector / 256 ; Int vector page LD I,A ; LD A,%0 0 1 0 0111 ; Send an Interrupt control word OUT (PioAK),A ; OUT (PioBK),A ; (DI) LD A,%0 0 1 0 0111 ; Again OUT (PioAK),A ; OUT (PioBK),A ; LD A,%0 0 1 1 0111 ; Interrupt control word OUT (PioBK),A ; (DI) LD A,%0 111 1111 ; Mask field OUT (PioBK),A ; LD A,%11 11 1111 ; Control OUT (PioBK),A ; LD A,%1 0 0 0 1 1 1 1 ; Inputs except for triac controls OUT (PioBK),A ; LD A,Int_Vector & #FF ; Int vector low word OUT (PioBK),A ; to PIO LD A,%1 0 1 1 0111 ; Interrupt control word OUT (PioBK),A ; LD A,%0 111 1111 ; Mask field OUT (PioBK),A ; RETI ; Clear prioritys and go ; Reset machine Watch_Fail DI ; Fail JP Start ; ; 50 Hz zero-cross interrupt Int_Routine PUSH HL ; Save PUSH BC ; PUSH AF ; LD HL,0 ; Check SP ADD HL,SP ; LD BC,Low_SP-8 ; OR A ; SBC HL,BC ; JR C Watch_Fail ; Fail ADD HL,BC ; LD BC,High_SP-8 ; OR A ; SBC HL,BC ; JR NC Watch_Fail ; Fail ADD HL,BC ; HL := SP LD BC,6 ; Point at PC on stack ADD HL,BC ; LD A,(HL) ; Get PC INC HL ; LD H,(HL) ; LD L,A ; LD BC,Low_PC ; OR A ; SBC HL,BC ; JR C Watch_Fail ; Fail ADD HL,BC ; LD BC,High_PC ; OR A ; SBC HL,BC ; JR NC Watch_Fail ; Fail ; Is the triac data valid ? LD A,(Triac_Time) ; Not timed out yet ? OR A ; JR Z Watch_Fail ; Time-out, reset it all DEC A ; Step down LD (Triac_Time),A ; ; Drive them LD A,(Triacs) ; Bits 0,1,2,3 are the triacs ; Bits 4,5,6,7 are the relays LD C,A ; Active state AND %1111 0000 ; Mask for inactive state LD B,Pulse_Cnt ; Try a lot LD HL,Triac_Port ; Point at port IR_Lp LD (HL),C ; Active LD (HL),A ; Inactive DJNZ IR_Lp ; Loop JR IR_Step_Timer ; Skip fault code ; Pull out the relays IR_Triacs_OFF LD A,%0000 0000 ; All off LD (Triac_Port),A ; ; Step timer IR_Step_Timer LD HL,(Int_Cnt) ; Step it INC HL ; LD (Int_Cnt),HL ; LD A,L ; 0 ? OR H ; JR NZ IR_Exit ; No, done ; Every 22 minutes we set this flag LD A,1 ; Set the event flag LD (CRU_Period_Ends),A ; IR_Exit POP AF ; POP BC ; POP HL ; EI ; Done RETI ; ; Assert that the triac flags are valid (for 2.5 seconds) Triacs_Valid PUSH AF ; Save it LD A,255 ; Valid for 2.5 seconds LD (Triac_Time),A ; POP AF ; Restore RET ; Done ; Setup the LCD Init_LCD LD A,#38 ; Two lines CALL Send_LCD_K ; Send it CALL Send_LCD_K ; CALL Send_LCD_K ; LD A,#06 ; CALL Send_LCD_K ; LD A,#0C ; Cursor off CALL Send_LCD_K ; LD A,#01 ; JP Send_LCD_K ; Cursor_Off PUSH AF ; Save acc LD A,#0C ; Cursor off command CALL Send_LCD_K ; POP AF ; RET ; Cursor_On PUSH AF ; Save acc LD A,#0F ; Cursor on command CALL Send_LCD_K ; POP AF ; RET ; Clear_LCD LD A,#01 ; Clear display CALL Send_LCD_K ; LD A,%0 000000 ; Home it JP Set_Cursor ; Last_Inst EQU $ ; End of code Key_Codes DEFB "M",#08,"159" DEFB "PS260" DEFB "RE37",#0D DEFB "UD48",#0D knInc EQU 15 ; "+" knDec EQU 16 ; "-" knNC EQU 14 ; Nonexistent key kn1 EQU 2 ; "1" kn2 EQU 7 ; "2" kn3 EQU 12 ; "3" kn4 EQU 17 ; "4" knMO EQU 10 ; "MO" ; ENCRYPT #5A,0,0 ; XOR the second password ; Real zeus supports encryption Password2 DEFB "0978",#0D,"856130",#0D,#80 ; ENCRYPT enXOR,enADD,enMASK ; Encrypt strings ; Real zeus supports encryption sON DEFB "ON ",0 ; Various strings sOFF DEFB "OFF",0 ; sBlank DEFB " ",0 ; " " sVirt_Spc DEFB " ",0 ; " " sTooHigh DEFB "HIGH ",0 ; Out of range error sTooLow DEFB "LOW " ,0 ; Out of range error sNTooHigh DEFB "***",0 ; Out of range error sEPROM_Fail DEFB "Controller Fault - Suspect EPROM " DEFB "Part No. '30 920 037' [CANCEL]",0 sError DEFB "Some sort of failure has occurred. " DEFB " [CANCEL]",0 sTF_1 DEFB "Reflow Zone Fault - Suspect TRIAC " DEFB "Part No. '35 689 025' [CANCEL]",0 sTF_2 DEFB "Pre Heat 2 Fault - Suspect TRIAC " DEFB "Part No. '35 689 025' [CANCEL]",0 sTF_3 DEFB "Pre Heat 1 Fault - Suspect TRIAC " DEFB "Part No. '35 689 025' [CANCEL]",0 sTHF_0 DEFB "Reflow Zone Fault - Suspect Thermocouple" DEFB "Part No. '25 247 001' [CANCEL]",0 sTHF_1 DEFB "Pre Heat 2 Fault - Suspect Thermocouple " DEFB "Part No. '25 247 001' [CANCEL]",0 sTHF_2 DEFB "Pre Heat 1 Fault - Suspect Thermocouple " DEFB "Part No. '25 247 001' [CANCEL]",0 sTHF_3 DEFB "Sub Zone Fault - Suspect Thermocouple " DEFB "Part No. '25 247 001' [CANCEL]",0 sManual DEFB "Demand "," " DEFB "Actual "," ",0 sProfile DEFB "P [001] " DEFB "Actual "," ",0 sProfile_NP DEFB "Profile not used " DEFB "Press any key ",0 sMotorSpeed DEFB "Motor speed % " DEFB " mm/minute . inches/minute ",0 sSave DEFB "Which profile number ? " DEFB " ",0 sDelete DEFB "Press if you wish to delete a " DEFB "profile, else press to ignore. ",0 sSave_IP DEFB "Invalid profile number " DEFB "Press any key ",0 sSave_PE DEFB "This profile exists " DEFB " to replace it ",0 sSave_PS DEFB "Profile now stored " DEFB " ",0 sP1_Cal DEFB "Test ADC converters " DEFB ", ",0 sP1_Cal_Str DEFB "Demand "," " DEFB "Actual "," ",0 sP1_Test DEFB "Test Triacs and drivers " DEFB ",, ",0 sP1_Test_Str DEFB "Triac " DEFB "Actual ",0 sP1_Limit DEFB "Edit the warning light temp. limits " DEFB ",, ",0 sP1_Limit_Str DEFB "Over RF+ ",cDeg DEFB "C P2+ ",cDeg DEFB "C P1+ ",cDeg DEFB "C SZ+ ",cDeg,"C" DEFB "Under - ",cDeg DEFB "C - ",cDeg DEFB "C - ",cDeg DEFB "C - ",cDeg,"C",0 sP1_Erase DEFB "Erase all profiles " DEFB ",, ",0 sP1_Erase_Done DEFB "All Profiles Erased " DEFB " ",0 sP1_Define DEFB "Set the default profiles " DEFB ",, ",0 sP1_Version DEFB "Version 4.0 This EPROM assembled on :- " ; TIMESTR,0 DEFB #0D,#0D,#0D DEFM ". . all that we see or seem is but a dream" DEFM " within a dream. " DEFB #00 sCopyright DEFB " (c) Simon Brattel of Maelor Display " DEFB " Systems Ltd. and Design-Design Software",0 sMess_1 DEFB " OK, I give up, there are some more bits" DEFB "hidden in the ROMs, but I'm afraid that ",0 sMess_2 DEFB "after all the crud I used to hide in the" DEFB "games this is all very tame, but then ",0 sMess_3 DEFB "what can you do with a display like this" DEFB "after all ? ",0 sMess_4 DEFB "So that's it. You'll have to search for " DEFB "the rest, it's encrypted, what fun. ",0 sMess_5 DEFB "And only one thing remains to say . . . " DEFB '"Where''s the Hi-Score table ?" ',0 ; ENCRYPT 0,0,0 ; Kill the encryption ; Real zeus supports encryption DEFW 0,0 ; Term Menu_1 DEFW sP1_Cal,P1_Cal ; Calibrate DEFW sP1_Test,P1_Test ; Test triacs DEFW sP1_Limit,P1_Limit; Edit limits DEFW sP1_Erase,P1_Erase; Erase profiles DEFW sP1_Version,Return; Show version DEFW 0,0 ; Term Menu_2 DEFW sCopyright,Return ; Silly messages DEFW sCopyright,Return ; DEFW sMess_1,Return ; DEFW sMess_2,Return ; DEFW sMess_3,Return ; DEFW sMess_4,Return ; DEFW sMess_5,Return ; DEFW sCopyright,Return ; DEFW 0 ; Term EM_Tab DEFW sError,sTF_1,sTF_2,sTF_3 ; Triac failures DEFW sError,sError,sError,sError ; Therm_Fail_Tab DEFW sTHF_0,sTHF_1,sTHF_2,sTHF_3 ; Thermocouple fails DEFM "Z80 housed and trained (Hardware and Software) by " DEFM "(c) Simon Brattel of Maelor Display Systems " DEFM "Ltd. (0978) 660145" DEFB #0D DEFM "This version assembled at " ; TIMESTR ; Used to plant the time as a string DEFB " " DEFM "It's very unprofessional , but you " DEFM "may change the following strings if " DEFM "required. Changes to any other part " DEFM "of the EPROM will result in software " DEFM "faults which may not be discovered for months, " DEFM "and which could even damage the machine. " DEFM "You have been warned." ; CHECKSUM Z ; Dump bytes for Zero checksum ; Real zeus supports... Bugger it, easier to add it to this one. Check_End EQU $ ; This is the checksum end address DEFS #20,0 sInit DEFB " OK Industries " DEFB " Profile Controller ",0 DEFS #20,0 Conv_Table DEFM " 72 283" ; 0 DEFM " 76 300" ; DEFM " 81 317" ; DEFM " 85 334" ; DEFM " 89 351" ; DEFM " 93 368" ; DEFM " 98 384" ; DEFM "102 401" ; DEFM "106 418" ; DEFM "110 435" ; DEFM "115 452" ; 10 DEFM "119 468" ; DEFM "123 485" ; DEFM "128 502" ; DEFM "132 519" ; DEFM "136 536" ; DEFM "140 552" ; DEFM "145 569" ; DEFM "149 586" ; DEFM "153 603" ; DEFM "157 620" ; 20 DEFM "162 636" ; DEFM "166 653" ; DEFM "170 670" ; DEFM "174 687" ; DEFM "179 704" ; DEFM "183 721" ; DEFM "187 737" ; DEFM "192 754" ; DEFM "196 771" ; DEFM "200 788" ; 30 DEFM "204 805" ; DEFM "209 821" ; DEFM "213 838" ; DEFM "217 855" ; DEFM "221 872" ; DEFM "226 889" ; DEFM "230 905" ; DEFM "234 922" ; DEFM "239 939" ; DEFM "243 956" ; 40 DEFM "247 973" ; DEFM "251 990" ; DEFM "2561006" ; DEFM "2601023" ; DEFM "2641040" ; DEFM "2681057" ; DEFM "2731074" ; DEFM "2771090" ; DEFM "2811107" ; DEFM "2861124" ; 50 DEFM "2901141" ; DEFM "2941158" ; DEFM "2981174" ; DEFM "3031191" ; DEFM "3071208" ; DEFM "3111225" ; DEFM "3151242" ; DEFM "3201259" ; DEFM "3241275" ; DEFM "3281292" ; 60 DEFM "3321309" ; DEFM "3371326" ; DEFM "3411343" ; DEFM "3451359" ; DEFM "3501376" ; DEFM "3541393" ; DEFM "3581410" ; DEFM "3621427" ; DEFM "3671443" ; DEFM "3711460" ; 70 DEFM "3751477" ; DEFM "3791494" ; DEFM "3841511" ; DEFM "3881527" ; DEFM "3921544" ; DEFM "3971561" ; DEFM "4011578" ; DEFM "4051595" ; DEFM "4091612" ; DEFM "4141628" ; 80 DEFM "4181645" ; DEFM "4221662" ; DEFM "4261679" ; DEFM "4311696" ; DEFM "4351712" ; DEFM "4391729" ; DEFM "4431746" ; DEFM "4481763" ; DEFM "4521780" ; DEFM "4561796" ; 90 DEFM "4611813" ; DEFM "4651830" ; DEFM "4691847" ; DEFM "4731864" ; DEFM "4781881" ; DEFM "4821897" ; DEFM "4861914" ; DEFM "4901931" ; DEFM "4951948" ; DEFM "4991965" ; DEFM "5031981" ; 100 DEFB "*************" DEFB "The 7 characters after the next asterix are the password" ORG ($ or #0F)+1 DEFB "*" Password1 DEFB "3502286",#0D,#80 ORG RamBott Int_Cnt DEFS 2 ; Changed every interrupt CRU_Period_Ends DEFS 1 ; Set every 22 minutes Triacs DEFS 1 ; States of triacs Triac_Time DEFS 1 ; Time since change cADC_0 DEFS 2 ; Actual inputs cADC_1 DEFS 2 cADC_2 DEFS 2 cADC_3 DEFS 2 cADC_4 DEFS 2 ; Demand temps cADC_5 DEFS 2 cADC_6 DEFS 2 cADC_7 DEFS 2 ; The next 16 bytes comprise the profile format Motor_Speed DEFS 2 Demand_0 DEFS 2 ; Demand temperatures Demand_1 DEFS 2 Demand_2 DEFS 2 Demand_3 DEFS 2 Check_Byte DEFS 1 DEFS 16 ; Extra space Light_Dem_0 DEFS 2 ; Current demand temps Light_Dem_1 DEFS 2 ; Light_Dem_2 DEFS 2 ; Light_Dem_3 DEFS 2 ; Lights DEFS 1 ; Lights Current_Profile DEFS 2 Virtual_Profile DEFS 2 bLatch_0 DEFS 1 dwMS_MS DEFS 2 Error_Number DEFS 1 Flash_Mess_Rate DEFS 1 Motor_Voltage DEFS 2 ; Working voltage for belt motor CRU_Data_0 DEFS 4 ; Data for triac/relay check CRU_Data_1 DEFS 4 ; Data for triac/relay check CRU_Data_2 DEFS 4 ; Data for triac/relay check Key_Data DEFS 20 ; De-bounce counts Buffer DEFS 16 ; Large buffer ! Mess_Buffer DEFS 81 ; LCD buffer Cursor DEFS 1 ; Cursor position Startup DEFS 1 ; Startup flag ORG RamBott + #2E0 ; Fixed address Limit_RF_Above DEFS 2 ; Limit_RF_Below DEFS 2 ; Limit_P2_Above DEFS 2 ; Limit_P2_Below DEFS 2 ; Limit_P1_Above DEFS 2 ; Limit_P1_Below DEFS 2 ; Limit_SZ_Above DEFS 2 ; Limit_SZ_Below DEFS 2 ; Default_Profile DEFS 16 ; 00 Profiles DEFS nProfiles * 16 Ye_End EQU $