; Monday 10:14:02 am 22/05/89 pEPCI_D EQU %00 0000 00 ; Data pEPCI_S EQU %00 0000 01 ; Status pEPCI_M EQU %00 0000 10 ; Mode bytes pEPCI_C EQU %00 0000 11 ; Command byte pKBD EQU %01 000000 ; Bottom 6 bits of address scan them pCRTC_A EQU %10 00000 0 ; Address register pCRTC_D EQU %10 00000 1 ; Data pOptions EQU %11 000000 ; Latch (Write only) cREFRSH EQU #E1 ; Update display cRESET EQU #E2 ; Cold start cDES_ON EQU #E3 ; Show Deselected keys cDES_OFF EQU #E4 ; Don't show Deselected keys cTEST EQU #EF ; Just ignore these messages cACK EQU #F0 ; ACK Time_10ms EQU 420 ; 10mS Delay value (@ 4mHz) Flash_Time EQU 99 ; Flash state time Full_Count EQU 8 ; About 3 seconds of flashing Chars EQU #1D00 ; 20-7F ; ORG #E000 ORG #0000 JP Cold_Start ; Jump to start ORG #38 JP Int_Routine ; Vector to interrupt routine ORG #66 JP Cold_Start Cold_Start LD SP,RamBott ; Set up stack DI ; Kill the interrupts LD BC,10000 ; Wake up CALL Pause ; CALL Init_All ; Setup machine LD A,cRESET ; Send cold start CALL Send_Message_Byte ; JR Main ; Go Warm_Start LD SP,RamBott ; Set up stack DI ; Kill the interrupts CALL Init_All ; Setup machine LD A,cREFRSH ; Send warm start CALL Send_Message_Byte ; JR Main ; Go Change_Page POP AF ; Loose HL,DE POP AF ; LD A,(Current_Page) ; Get page XOR #01 ; Change LD (Current_Page),A ; Store Main CALL Write_All_Keys ; Update the display LD DE,Flash_State_Tab-1; Point at table Flash_Loop CALL Flash_Update ; Change display LD HL,Flash_Time ; Time to next Main_Loop PUSH HL ; Save flash rate PUSH DE ; Save flash ptr CALL Read_Key ; Get a key ? JR NC Main_NoKey ; None CP #80 ; SELECT ? JR Z Change_Page ; Yes, change page CALL Convert_Key_Code ; Get the message code CALL NC Send_Message_Byte ; Send the code Main_NoKey CALL Deal_With_Message ; See if any commands received LD BC,700 ; Even out times CALL Pause ; CALL Write_Select ; Change key string POP DE ; Get flash ptr POP HL ; Get flash time DEC HL ; Wait for flash LD A,L ; OR H ; JR NZ Main_Loop ; JR Flash_Loop ; Loop Flash_Update INC DE ; Step ptr to table LD A,(DE) ; Get next state BIT 7,A ; Invalid state ? JR Z FU_1 ; OK LD DE,Flash_State_Tab ; Rewind ptr FU_1 LD A,(DE) ; Get current state LD (Flash_State),A ; Save it PUSH DE ; Save count CALL Step_Full_Count ; Decrement any displays' count LD A,(Flash_State) ; Get flash state CALL Assert_Page ; Show it POP DE ; Done RET ; ; Decrement any FULL Counts, and clear state if done Step_Full_Count LD IX,Key_Data_Tab ; Point at keys LD C,0 ; Key number SFC_Lp LD A,(IX+dkCount) ; FULL ? OR A ; JR Z SFC_Next ; No, done DEC A ; Dec it LD (IX+dkCount),A ; Store JR NZ SFC_Next ; Not done, next LD A,C ; Key number CALL Update_Key ; Change display SFC_Next LD DE,dkLength ; Step to next ADD IX,DE ; INC C ; Next key LD A,C ; All done ? CP 40 ; JR NZ SFC_Lp ; Loop RET ; Done ; Get the next received message out of the buffer and act on it Deal_With_Message LD A,(nRx_Mess) ; Any messages ? OR A ; RET Z ; No, ignore CALL Read_Message ; Get it into buffer OR A ; Length 0 RET Z ; Yep, ignore it CP 1 ; One byte ? JR NZ DWM_Long ; No, long message LD A,(DE) ; Get the byte CP cTEST ; Test connection ? RET Z ; Yep CP cRESET ; Reset ? JP Z Warm_Start ; Yes CP cDES_ON ; Deselect on ? JP Z Assert_Deselect ; Yep CP cDES_OFF ; Deselect off ? JP Z Negate_Deselect ; Yep RET ; Done (Ignore it) DWM_Long LD A,(DE) ; Get byte INC DE ; Skip OR A ; End ? RET Z ; Yes, done CP #80 ; Addr or status ? JR C DWM_Long ; No, fail CP #A8 ; Addr ? JR NC DWM_Long ; No, fail ; Got an address SUB #80 ; (m)align LD (cKey_Addr),A ; Store it CALL Get_Key_Ptr ; IX := ptr to Key_Data PUSH IX ; Reset text ptr POP HL ; LD C,0 ; Reset char count JR DWM_KeyLp ; Decode message DWM_KillText PUSH IX ; Reset text ptr POP HL ; LD C,0 ; Reset char count LD (HL),0 ; Terminate DWM_KeyLp LD A,(DE) ; Get char INC DE ; OR A ; End ? JR Z DWM_KX ; Yes, Done CP #7F ; Clear JR Z DWM_KillText ; Yes JR NC DWM_K1 ; Not text, skip BIT 3,C ; C = 8 ? JR NZ DWM_KeyLp ; Yes, maxm. no. of chars LD (HL),A ; Add char INC HL ; INC C ; One more JR DWM_KeyLp ; Loop DWM_K1 SUB #C0 ; Status ? RET C ; No, fail CP #20 ; Status ? RET NC ; No, fail CALL Alter_Key_Status ; Update the key JR DWM_KeyLp ; Another ? DWM_KX LD A,(cKey_Addr) ; Get key number JP Update_Key ; Show new key state ; A = Key's number (0..39) change it on display if necc. ; Also (un)link it to Scr list as necc. Update_Key PUSH IY ; Save PUSH IX ; PUSH HL ; PUSH DE ; PUSH BC ; PUSH AF ; LD (cKey_Addr),A ; Store addr CALL Get_Key_Ptr ; IX := ptr to keys' data LD C,A ; Save number LD IY,pScr_0-dkpNext_Scr ; Assume page 0 displayed LD B,0 ; Assume page 0 SUB 20 ; Key on page 0 or 1 ? JR C UK_1 ; 0 LD C,A ; Key to show in 0..19 LD IY,pScr_1-dkpNext_Scr ; Page 1 displayed LD B,1 ; On page 1 UK_1 LD (Temp_Scr_List),IY ; Save ptr LD A,(Current_Page) ; Same page ? XOR B ; AND %0000000 1 ; JR NZ UK_AltPage ; No, key is on other page PUSH IY ; Save Next_Scr ptr PUSH IX ; Copy ptr POP IY ; LD A,C ; Display key CALL Write_Key ; POP IY ; Restore ; Check status BIT 5,(IX+dkStatus) ; Deselected ? JR NZ UK_D_Remove ; Yes, remove from scratch LD A,(IX+dkStatus) ; Get status of key AND %00 0 11111 ; C0 ? JR Z UK_D_Remove ; Yes, remove from scratch ; Is this a state for the scratch list ? CALL Get_pPriority ; Look up priority BIT 0,(HL) ; Get flag JR Z UK_Done ; Not priority, done PUSH IY ; Save ptr CALL Scr_Find ; Is it already in list ? JR C UK_Done_IY ; Yes, ignore ; Add to end of list PUSH IX ; Get Key address POP HL ; LD (IY+dkpNext_Scr),HL ; Add to end of list LD (IX+dkpNext_Scr),0 ; Terminate list LD (IX+dkpNext_Scr+1),0; LD (IX+dkScr_Y),0 ; Not yet shown JR UK_Done_IY ; Done UK_D_Remove PUSH IY ; Save ptr CALL Scr_Find ; Is it in list ? JR NC UK_Done_IY ; No, ignore it ; Yes, remove it LD HL,(IX+dkpNext_Scr) ; Ptr LD (IY+dkpNext_Scr),HL ; Previous JR UK_Done_IY ; Done UK_AltPage PUSH IY ; Save ptr CALL Scr_Find ; Find it JR NC UK_A_Add ; No, add it if priority ; Check status BIT 5,(IX+dkStatus) ; Deselected ? JR NZ UK_A_Remove ; Yes, remove from scratch LD A,(IX+dkStatus) ; Get status of key AND %00 0 11111 ; C0 ? JR Z UK_A_Remove ; Yes, remove from scratch ; Now show it if on screen LD A,(IX+dkScr_Y) ; Get Key OR A ; JR Z UK_A_Done_IY ; Not shown ADD A,20 ; Show it in scratch PUSH IX ; Copy ptr POP IY ; CALL Write_Key ; JR UK_A_Done_IY ; Done UK_A_Remove CALL Scr_Remove_U ; Remove it JR UK_A_Done_IY ; Done UK_A_Add BIT 5,(IX+dkStatus) ; Deselected ? JR NZ UK_A_Done_IY ; Yes, don't add to scratch LD A,(IX+dkStatus) ; Get status of key AND %00 0 11111 ; Mask CALL Get_pPriority ; Get ptr to flag BIT 0,(HL) ; Get flag JR Z UK_A_Done_IY ; Not priority, done CALL Scr_Add_U ; Add it to the list UK_A_Done_IY POP IY ; Restore ptr UK_A_Done PUSH IY ; Ptr into IX POP IX ; CALL Scr_Queueing_Pri ; Check for priority keys JR UK_Done ; Exit UK_Done_IY POP IY ; Restore ptr UK_Done POP AF ; Restore POP BC ; POP DE ; POP HL ; POP IX ; POP IY ; RET ; Dummy ; Find the key (IX) in the current list ; return (NC) list ptr to last entry if not found ; return (C) list ptr to previous entry if found SF_Next PUSH HL ; Load pointer POP IY ; Scr_Find LD HL,(IY+dkpNext_Scr) ; Get the pointer to the next entry LD A,L ; End ? OR H ; RET Z ; Yes (NC) LD A,IXL ; Current key ? CP L ; Same ? JR NZ SF_Next ; No, try next LD A,IXH ; Current key ? CP H ; Same ? JR NZ SF_Next ; No, try next SCF ; Found RET ; Done ; Given IY = ptr to last entry in list, adds IX to list Scr_Add_U PUSH IX ; Get ptr to current POP HL ; LD (IY+dkpNext_Scr),HL ; Add it to list LD (IX+dkpNext_Scr),0 ; Terminate list LD (IX+dkpNext_Scr+1),0; LD (IX+dkScr_Y),0 ; Not yet shown PUSH IX ; Save ptr LD IY,(Temp_Scr_List) ; Get list ptr CALL Scr_Tidy_List_IY ; Sort it etc CALL Write_Scratch_No ; Show the number if different POP IX ; Restore LD A,(IX+dkScr_Y) ; Have we now got a key slot ? OR A ; RET Z ; No, done ADD A,20 ; Calc key no. PUSH IX ; Copy ptr POP IY ; JP Write_Key ; Show new one ; Given IY = ptr to previous, IX = ptr to current removes current Scr_Remove_U LD HL,(IX+dkpNext_Scr) ; Next LD (IY+dkpNext_Scr),HL ; Into previous LD A,(IX+dkScr_Y) ; Visible ? PUSH AF ; Save PUSH IX ; Save ptr LD IY,(Temp_Scr_List) ; Get list ptr CALL Scr_Tidy_List_IY ; Sort it etc CALL Write_Scratch_No ; Show the number if different POP IX ; Restore POP AF ; Restore Scr_Y OR A ; Was it visible ? RET Z ; No, done ; Now we must show the key that replaced it LD IY,(Temp_Scr_List) ; Get the list LD C,A ; Get the Scr_Y SRU_Lp LD HL,(IY+dkpNext_Scr) ; Get the next one LD A,L ; End ? OR H ; JR Z SRU_Blank ; Yes, simply clear key PUSH HL ; Point at it POP IY ; LD A,(IY+dkScr_Y) ; Get its Scr_Y CP C ; Same ? JR NZ SRU_Lp ; Yes, show this key ADD A,20 ; Make scratch area JP Write_Key ; Show it SRU_Blank LD A,C ; Scratch key ADD A,20 ; JP SSL_Clear ; Clear it ; Update all the keys on display including scratch area Write_All_Keys LD IY,Key_Data_Tab ; Assume first 20 keys LD A,(Current_Page) ; Is 0 ? OR A ; JR Z WAK_1 ; Yes LD IY,Key_Data_Tab+(20*16) ; Next 20 keys WAK_1 LD A,0 ; Key number 0 WAK_Lp CALL Write_Key ; Show it LD BC,dkLength ; Step to next ADD IY,BC ; INC A ; Next display CP 20 ; Done ? JR NZ WAK_Lp ; No, loop ; Now show scratch list CALL Get_Scr_Ptr ; IX := Ptr to current scratch list CALL Scr_Tidy_List ; Tidy the list CALL Write_Scratch_No ; Show the number CALL Scr_Queueing_Pri ; Detect priority key overflow CALL Scr_Show_List ; Show scratch keys RET ; Done ; Return IX Get_Scr_Ptr LD IX,pScr_1-dkpNext_Scr ; Point to list for page 0 LD A,(Current_Page) ; Test page OR A ; RET Z ; Yes, page 0 LD IX,pScr_0-dkpNext_Scr ; List for page 1 RET ; Done ; Return A (no of entries) and tidy list Scr_Tidy_List PUSH IX ; Save ptr PUSH IX ; CALL Scr_Count ; Count the entries (A,DE) POP IX ; Done PUSH AF ; Save count LD B,A ; Count STL_Lp LD HL,(IX+dkpNext_Scr) ; Point at next PUSH HL ; Point POP IX ; LD A,B ; All done ? OR A ; JR Z STL_Done ; Yes DEC B ; Dec no. remaining LD A,(IX+dkScr_Y) ; This one visible ? OR A ; JR NZ STL_Lp ; Yes, ignore it LD A,(DE) ; Get next free slot OR A ; JR Z STL_Lp ; No slot visible LD (IX+dkScr_Y),A ; Put it in this slot INC DE ; Step ptr to next free slot JR STL_Lp ; Loop STL_Done POP AF ; Restore count POP IX ; Restore ptr RET ; Done ; Same again, using IY Scr_Tidy_List_IY PUSH IY ; Save PUSH IX ; PUSH IY ; Load POP IX ; CALL Scr_Tidy_List ; Sort POP IX ; Restore POP IY ; RET ; Done ; Return count in A, ptr to free slots in DE Scr_Count LD C,0 ; Count := 0 LD B,%00000 1 1 1 ; Slots free SC_Lp LD HL,(IX+dkpNext_Scr) ; Point at next entry LD A,L ; End ? OR H ; JR Z SC_Done ; Yes PUSH HL ; Point at it POP IX ; INC C ; One more entry LD A,(IX+dkScr_Y) ; Has this got a slot ? OR A ; JR Z SC_Lp ; No, loop CALL RES_A_in_B ; Reset flag JR SC_Lp ; Loop SC_Done LD HL,Slot_Buffer ; Create free list PUSH HL ; Save ptr LD A,1 ; First slot = 1 SCD_Lp RR B ; Slot free ? JR NC SC_1 ; Used LD (HL),A ; One free INC HL ; SC_1 INC A ; Step to next CP 4 ; Loop JR NZ SCD_Lp ; LD (HL),0 ; End buffer POP DE ; Ptr to DE LD A,C ; A := Count RET ; Done ; Reset bit A-1 of B RES_A_in_B CP 1 ; 1 ? JR Z RAB_1 ; Yes CP 2 ; 2 JR Z RAB_2 ; Yes ; Must be 3 RES 2,B ; RES 3-1,B RET ; Done RAB_2 RES 1,B ; RES 2-1,B RET ; Done RAB_1 RES 0,B ; RES 1-1,B RET ; Done ; A = Number, show it in select key Write_Scratch_No SUB 3 ; 3 or more ? JR NC WSN_No ; Yes XOR A ; Show 0 WSN_No LD C,A ; Save LD A,(cScratch_No) ; Unchanged ? CP C ; RET Z ; Yes, ignore CALL WSN_Clear ; Clear it LD A,C ; Save new number LD (cScratch_No),A ; ; XOR New one on LD HL,' ' ; Clear numbers WSN_Lp OR A ; Done ? JR Z WSN_WN ; Yes DEC A ; -1 PUSH AF ; Save LD A,L ; Step units INC A ; OR "0" ; Make Number LD L,A ; CP #3A ; Overflow ? JR NZ WSN_a ; No LD L,"0" ; Yes LD A,H ; Step tens INC A ; OR "0" ; LD H,A ; WSN_a POP AF ; Restore JR WSN_Lp ; Loop WSN_WN LD DE,#8000+(18*5)+(16*#80)+3 ; Address of number LD B,4 ; Offset LD C,%1 1 1 1 1 ; Flags LD A,H ; Show tens CALL Write_Char ; DEC DE ; Step ptr LD A,L ; Show units CALL Write_Char ; RET ; Done WSN_Clear LD HL,AI_Clear ; Clear AI defn. LD A,20 ; SELECT Key JP Show_Fill ; Clear it ; Given IX find out if there are priority keys which are not ; visible in the scratch area, and flag this if there are none ; which are visible, and make select box flash PRIORITY. Scr_Queueing_Pri PUSH IX ; Save ptr LD C,0 ; Flag SQP_Lp LD HL,(IX+dkpNext_Scr) ; Get the ptr LD A,L ; End ? OR H ; JR Z SQP_Done ; Yes, save flag PUSH HL ; Load ptr POP IX ; LD A,(IX+dkStatus) ; Get status AND %00 0 11111 ; Mask CALL Get_pPriority ; Get its flag BIT 1,(HL) ; Is this a priority state ? JR Z SQP_Lp ; No, loop LD A,(IX+dkScr_Y) ; Is it visible in scratch area ? OR A ; JR NZ SQP_NoneHidden ; Yes, no problem LD C,1 ; Assert hidden flag JR SQP_Lp ; Look further SQP_NoneHidden LD C,0 ; Clear flag SQP_Done LD A,C ; Store flag LD (Sel_State),A ; POP IX ; Restore RET ; Done ; IX = ptr to scratch list, show it Scr_Show_List LD B,%00000 1 1 1 ; Assert page flags SSL_Lp LD HL,(IX+dkpNext_Scr) ; Get next entry LD A,L ; End ? OR H ; JR Z SSL_Done ; Yes, clear rest PUSH HL ; Get ptr POP IX ; LD A,(IX+dkScr_Y) ; On screen ? OR A ; JR Z SSL_Lp ; No, loop CALL RES_A_in_B ; Clear flag ADD A,20 ; Key number 21,22,23 PUSH IX ; Use other ptr POP IY ; CALL Write_Key ; Show it JR SSL_Lp ; Loop ; Now clear unused ones SSL_Done LD A,21 ; Key number BIT 0,B ; Flag CALL NZ SSL_Clear ; Clear if unused LD A,22 ; BIT 1,B ; CALL NZ SSL_Clear ; LD A,23 ; BIT 2,B ; RET Z ; ; A = Key posn clear display SSL_Clear PUSH BC ; Clear this key LD HL,All_Clear ; Definition for area fill CALL Show_Fill ; POP BC ; Done RET ; ; IY = ptr to key_data ; A = key no. Write_Key CP 24 ; Valid key ? CCF ; RET C ; Fail PUSH IX ; Save PUSH HL ; PUSH DE ; PUSH BC ; PUSH AF ; LD (cKey_No),A ; Save key number LD A,(IY+dkCount) ; FULL ? OR A ; JR Z WK_0 ; No, use normal state LD A,(IY+dkStatus) ; Get deselected flag AND %00 1 00000 ; OR %00 0 01110 ; CE JR WK_Full ; Set full state WK_0 LD A,(IY+dkStatus) ; Get the status byte AND %00 1 11111 ; Mask it WK_Full LD C,A ; Save it LD A,(Deselect_Mode) ; Deselected ? AND %1 ; Test JR Z WK_1 ; No, status valid LD A,%00 0 11111 ; Make 1F or 3F OR C ; LD C,A ; WK_1 LD A,C ; Get status ptr ADD A,A ; * 2 ADD A,Status_Tab & #FF ; Calc ptr LD L,A ; ADC A,Status_Tab / 256 ; SUB L ; LD H,A ; LD A,(HL) ; Get entry INC HL ; LD H,(HL) ; LD L,A ; PUSH HL ; Set ptr POP IX ; LD BC,dArea_Flags ; Offset ADD HL,BC ; LD A,(cKey_No) ; Get key number CALL Show_Fill ; Fill the key ; Show strings PUSH IY ; Get ptr to string POP HL ; LD C,(IX+dText_Flags) ; Pages LD A,(cKey_No) ; Get key number CALL Write_Label ; Show it LD C,(IX+dLocal_Flags) ; Pages LD HL,(IX+dpLocal) ; Get string LD A,(cKey_No) ; Get key number CALL Write_Label ; Show it ; Show AI LD C,(IX+dAI_Flags) ; Any AI text ? BIT 4,C ; Valid ? JR Z WK_Exit ; No LD A,(cKey_No) ; Get key number CALL Calc_pScreen ; Get a pointer to the display JR C WK_Exit ; Fail LD DE,4+(17*#80) ; Text offset ADD HL,DE ; EX DE,HL ; Into DE LD B,(IX+dAI_Offset) ; Text shift PUSH BC ; Save PUSH IX ; Get Base POP HL ; LD BC,dAI_Text ; Add offset ADD HL,BC ; POP BC ; Restore CALL Write_Label_Str ; Show it WK_Exit POP AF ; Restore POP BC ; POP DE ; POP HL ; POP IX ; OR A ; OK (NC) RET ; Done ; A = Key code ; HL = ptr to string ; C = Flags Write_Label BIT 4,C ; Valid ? RET Z ; No PUSH HL ; Save ptr to string CALL Calc_pScreen ; Get a pointer to the display JR C WK_Exit ; Fail LD DE,4+#80 ; Text offset ADD HL,DE ; EX DE,HL ; Into DE LD B,1 ; Text shift POP HL ; Restore CALL Write_Label_Str ; Show it RET ; Done ; HL = ptr to string ; DE = ptr to screen ; B = Shift ; C = flags Write_Label_Str PUSH IY ; Save regs PUSH DE ; PUSH BC ; CALL WLS_1 ; First line OR A ; End ? JR Z WLS_Done ; Exit INC E ; Rewind Text ptr INC E ; INC E ; INC E ; INC D ; Down 8 lines INC D ; INC D ; INC D ; CALL WLS_1 ; Next line WLS_Done POP BC ; Restore POP DE ; POP IY ; RET ; WLS_1 LD IYL,4 ; Maxm. 4 chars WLS_Lp LD A,(HL) ; Get char INC HL ; Step OR A ; RET Z ; Done CALL Write_Char ; Show the character DEC E ; Step cursor DEC IYL ; Loop JR NZ WLS_Lp ; LD A,1 ; Not end flag RET ; Done ; DE = ptr to key screen ; B = Shift number ; C = Flags ; A = Char Write_Char CP " " ; Space ? RET Z ; Done PUSH IY ; Save PUSH IX ; PUSH HL ; PUSH DE ; PUSH BC ; PUSH AF ; INC B ; 0..7 becomes 1..8 LD IYL,B ; Save shift number SUB #20 ; (m)align JR NC WC_1 ; Valid char XOR A ; Make space char WC_1 ADD A,A ; * 2 LD L,A ; Calc ptr to char LD H,0 ; ADD HL,HL ; * 4 ADD HL,HL ; 8 LD A,C ; Save mask LD BC,Chars ; Add base ADD HL,BC ; PUSH HL ; Transfer ptr POP IX ; LD C,A ; Restore mask LD B,8 ; Eight lines per char WC_Lp1 PUSH BC ; Save count LD L,(IX) ; Get char shape LD H,0 ; 16-bit INC IX ; Step ptr to char set LD B,IYL ; Shift count JR WC_a ; Try shift WC_Shift_Lp ADD HL,HL ; Shift 16 bit WC_a DJNZ WC_Shift_Lp ; Shift it CALL WC_Line ; Write one pixel line LD A,E ; Step down ADD A,#80 ; LD E,A ; ADC A,D ; Carry SUB E ; LD D,A ; POP BC ; Restore DJNZ WC_Lp1 ; Loop POP AF ; Restore POP BC ; POP DE ; POP HL ; POP IX ; POP IY ; RET ; Done WC_Line LD B,4 ; Do 4 planes WC_Lp2 RR C ; Check this plane JR NC WC_Lp2_X ; No, skip LD A,(DE) ; Write to display XOR L ; LD (DE),A ; DEC E ; LD A,(DE) ; XOR H ; LD (DE),A ; INC E ; WC_Lp2_X LD A,D ; Next plane ADD A,#10 ; LD D,A ; DJNZ WC_Lp2 ; Loop LD A,D ; Rewind ptr SUB #40 ; LD D,A ; RET ; Line done ; HL = ptr to fill Masks 0000 X X X X ; A = Key number Show_Fill PUSH HL ; Save registers PUSH DE ; PUSH BC ; PUSH AF ; PUSH IX ; Save ptr PUSH HL ; Get ptr to data POP IX ; CALL Calc_pScreen ; HL := Address JR C SF_Fail ; Illegal key number LD DE,Fill_Data ; Point at fill data area LD B,5 ; Do 5 areas SF_Lp_1 LD A,(IX) ; Get flags INC IX ; PUSH HL ; Save regs PUSH BC ; BIT 4,A ; Do this one ? CALL NZ SF_Fill_One ; Do one area LD HL,22 ; Step to next fill area ADD HL,DE ; EX DE,HL ; POP BC ; POP HL ; DJNZ SF_Lp_1 ; Loop OR A ; OK (NC) SF_Fail POP IX ; Restore ptr POP AF ; Restore POP BC ; POP DE ; POP HL ; RET ; Done ; A = Masks ; DE = ptr to Area definition ; HL = Address SF_Fill_One LD B,4 ; Do 4 planes SF_Lp PUSH BC ; Save ptr RRCA ; Get on/off flag PUSH AF ; Save masks PUSH HL ; Save ptr PUSH DE ; CALL SF_Fill ; Do it POP DE ; Restore POP HL ; LD A,H ; Step to next buffer ADD A,#10 ; LD H,A ; POP AF ; Restore flags POP BC ; Restore count DJNZ SF_Lp ; Loop RET ; Done SF_Fill PUSH AF ; Save flag (C) LD A,(DE) ; Get Offset INC DE ; Step LD B,A ; *256 LD C,0 ; SRA B ; * 128 RR C ; ADD HL,BC ; Step to start line LD A,(DE) ; Get length INC DE ; Step LD C,A ; Setup length POP AF ; Get Carry (Set or Reset) ? JR C SFF_1 ; Set (DE is OK) PUSH HL ; Step past Set data LD HL,10 ; ADD HL,DE ; EX DE,HL ; POP HL ; SFF_1 EX DE,HL ; Swap ptrs SFF_Lp_V PUSH HL ; Save ptr to masks LD B,5 ; 5 bytes SFF_Lp LD A,(DE) ; Data INC HL ; XOR (HL) ; Xor DEC HL ; AND (HL) ; AND it INC HL ; XOR (HL) ; OR it INC HL ; LD (DE),A ; Store INC DE ; Step DJNZ SFF_Lp ; Loop (line) LD HL,#80 - 5 ; Step down one line ADD HL,DE ; EX DE,HL ; DE := new ptr POP HL ; Rewind ptr DEC C ; Loop (vertical) JR NZ SFF_Lp_V ; RET ; Done Init_All CALL Clear_RAM ; Make RAM 0 CALL Init_Keys ; Setup scan data table CALL Init_Ints ; Setup 68661, etc CALL Init_CRTC ; Setup display CALL Init_Mode ; Setup modes CALL Init_Key_Data ; Setup key data areas CALL Init_Select ; "SELECT" key setup RET ; Done ; Make start_up consistent Clear_RAM LD HL,RamBott ; Start of Vars LD BC,#6000-RamBott ; Length XOR A ; Fill char JP Fill_Mem ; Fill it ; Init select key Init_Select XOR A ; Clear LD (Sel_State),A ; LD (cScratch_No),A ; No keys waiting DEC A ; Different value LD (Old_Sel_State),A ; Force update Write_Select LD A,(Old_Sel_State) ; Get the old (current) value LD B,A ; LD A,(Sel_State) ; Get the new state CP B ; Same ? RET Z ; Yes, done LD (Old_Sel_State),A ; Save it BIT 0,A ; SELECT or SELECT/PRIORITY JR NZ WS_Pri ; Alt ; Fill area LD HL,#8000+(18*5) ; Ptr to Key LD DE,Fill_Data ; LA LD A,%1 1 1 1 ; Steady fill CALL SF_Fill_One ; Fill it LD C,%1 1 1 1 1 ; Steady LD HL,sSELECT ; string CALL WS_Show ; Show string RET ; Done WS_Pri LD HL,#8000+(18*5) ; Ptr to Key LD DE,Fill_Data ; LA LD A,%0 1 0 1 ; Flash fill CALL SF_Fill_One ; Fill it LD C,%1 0 1 0 1 ; Flash LD HL,sSELECT ; string CALL WS_Show ; Show string LD HL,sPRIORITY ; string LD C,%1 1 0 1 0 ; Flash WS_Show LD A,20 ; Key number JP Write_Label ; Show it Init_Mode XOR A ; Clear LD (Deselect_Mode),A ; LD (Current_Page),A ; LD L,A ; 16 bit LD H,A ; LD (pScr_0),HL ; Clear LD (pScr_1),HL ; CALL Assert_Page ; Show page 0 RET ; Done Init_Key_Data LD HL,Key_Data_Tab ; Point at key data table LD BC,40*dkLength ; Length (bytes) XOR A ; Zero JP Fill_Mem ; Write it Init_CRTC LD HL,CRTC_Tab ; Point at data-table LD B,0 ; Counter ICRTC_Lp LD A,B ; Address OUT (pCRTC_A),A ; LD A,(HL) ; Data OUT (pCRTC_D),A ; INC HL ; Step ptr INC B ; Step addr LD A,B ; Done them all ? CP 40 ; JR NZ ICRTC_Lp ; Loop LD HL,#8000 ; Start of Vars LD BC,#4000 ; Length XOR A ; Fill char JP Fill_Mem ; Write it Init_Ints DI ; Kill the ints IM 1 ; Set the interrupt mode CALL Init_Serial ; Set the serial port up EI ; Enable interrupts RET ; Done Send_Message_Byte LD (Dummy),A ; Create message XOR A ; Terminate message LD (Dummy+1),A ; LD HL,Dummy ; Send message CALL Write_Tx_Mess ; RET ; Done Write_Tx_Mess PUSH HL ; Save ptr LD C,2 ; No. of chars +NOB,+Checksum WTxM_Length LD A,(HL) ; End ? OR A ; JR Z WTxM_NOB ; Yes, write NOB INC C ; One more char INC HL ; Step ptr JR WTxM_Length ; Loop WTxM_NOB LD A,C ; Get NOB CALL Force_Write_Tx ; Send it POP HL ; C also is checksum so far (NOB) WTxM_Lp LD A,(HL) ; Get char OR A ; End ? JR Z WTxM_X ; Yes CALL Force_Write_Tx ; Send it ADD A,C ; Accumulate Checksum LD C,A ; INC HL ; Step ptr JR WTxM_Lp ; Loop WTxM_X LD A,C ; Get checksum CALL Make_Checksum ; Make it valid CALL Force_Write_Tx ; Send it XOR A ; Terminate CALL Force_Write_Tx ; Send it LD HL,nTx_Mess ; One more message INC (HL) ; DI ; Interlock IN A,(pEPCI_C) ; Enable Tx ints SET 0,A ; OUT (pEPCI_C),A ; EI ; End RET ; Done Force_Write_Tx CALL Write_Tx ; Send char JR C Force_Write_Tx ; Fail, try again RET ; Done, sent Write_Tx PUSH HL ; Save regs PUSH DE ; PUSH AF ; LD HL,(pTx_In) ; Get input/output ptrs LD E,H ; LD H,Tx_Buffer/256 ; Set up page address LD (HL),A ; Save character INC L ; Step ptr LD A,L ; Get Input ptr CP E ; Input hit output ? JR Z W_Tx_Full ; Yes, no room in buffer LD (pTx_In),A ; Save ptr DI ; Interlock IN A,(pEPCI_C) ; Enable Tx SET 0,A ; OUT (pEPCI_C),A ; EI ; Interlock done OR A ; OK POP AF ; Restore POP DE ; POP HL ; RET ; Done W_Tx_Full SCF ; Fail POP AF ; Restore POP DE ; POP HL ; RET ; Done ; Get the next message into buffer (DE) Read_Message LD DE,Dummy ; Read message to dummy LD A,(pRx_Out) ; Get ptr LD L,A ; LD H,Rx_Buffer/256 ; Add base LD C,0 ; No chars yet RM_Lp LD A,(HL) ; Get char LD (DE),A ; INC L ; Step ptr OR A ; Done ? JR Z RM_Done ; Yes INC C ; One more char INC DE ; Step ptr JR RM_Lp ; Loop RM_Done LD A,L ; Move ptr LD (pRx_Out),A ; LD HL,nRx_Mess ; One less message DEC (HL) ; LD A,C ; No. of chars LD DE,Dummy ; Ptr to message RET ; Done Init_Serial LD A,%01 1 1 11 10 ; 1 Stop,Even,8 Bits,x16 OUT (pEPCI_M),A ; LD A,%0011 1110 ; 9600 Baud OUT (pEPCI_M),A ; LD A,%00 1 0 0 1 1 0 ; Rx enable, /RTS Asserted OUT (pEPCI_C),A ; XOR A ; Clear buffer ptrs LD (pRx_In),A ; LD (pRx_Out),A ; LD (pRx_Mess),A ; LD (pTx_In),A ; LD (pTx_Out),A ; LD (pTx_Mess),A ; LD (Rec_Count),A ; LD (Sending_Flag),A ; LD (nRx_Mess),A ; LD (nTx_Mess),A ; LD (Tx_Ack_Flag),A ; LD (Rx_Ack_Flag),A ; RET ; Done Int_Routine DI ; Kill the interrupts PUSH AF ; Save Regs PUSH BC ; PUSH HL ; IN A,(pEPCI_S) ; Get status BIT 1,A ; Recieved a char ? JR NZ IR_Recieve ; Yes, done BIT 0,A ; Tx empty ? JP NZ IR_Send ; Yes, send something Int_Exit POP HL ; Restore POP BC ; POP AF ; EI ; Ready again RET ; Done ; Recieive interrupt IR_Recieve IN A,(pEPCI_S) ; Get status AND %00 111 000 ; Check error bits JR NZ IR_Rx_Fail ; Failure IN A,(pEPCI_S) ; Anything received ? BIT 1,A ; JR Z Int_Exit ; No, spurious IN A,(pEPCI_D) ; Read data LD C,A ; Save char LD A,(Rec_Count) ; Receiving a message ? OR A ; JR NZ IR_Rx_Continue ; Yes, skip LD A,C ; Get char CP #20 ; NOB ? JR C IR_Rx_NOB ; Yes, start of message CP cACK ; ACK ? JR NZ Int_Exit ; No, ignore byte LD A,1 ; Assert ACK received flag LD (Rx_Ack_Flag),A ; JR Int_Exit ; Done IR_Rx_NOB LD A,(pRx_Mess) ; Save start of message LD (pRx_In),A ; LD A,C ; Initialise checksum LD (Rx_Checksum),A ; DEC A ; Already got one char LD (Rec_Count),A ; XOR A ; Kill sending flag LD (Sending_Flag),A ; (Incoming message has priority) JR Int_Exit ; Done IR_Rx_Continue LD HL,Rec_Count ; Dec number remaining DEC (HL) ; JR Z IR_Rx_LastChar ; None, this is the checksum LD A,(Rx_Checksum) ; Accumulate CS ADD A,C ; LD (Rx_Checksum),A ; LD A,C ; Get byte CALL Rx_StoreByte ; Store the byte in the buffer JR C IR_Rx_Kill_Mess ; Can't, kill the message JR Int_Exit ; Done IR_Rx_LastChar LD A,(Rx_Checksum) ; Get accumulated checksum CALL Make_Checksum ; Make it valid CP C ; Same as received ? JR NZ IR_Rx_Kill_Mess ; No, kill the message XOR A ; Terminate CALL Rx_StoreByte ; The message JR C IR_Rx_Kill_Mess ; Can't, kill the message LD A,(pRx_In) ; Move ptr LD (pRx_Mess),A ; LD A,(nRx_Mess) ; Another one INC A ; LD (nRx_Mess),A ; LD A,1 ; Assert ACK Required LD (Tx_Ack_Flag),A ; IR_Rx_Kill_Mess XOR A ; Kill message count LD (Rec_Count),A ; IN A,(pEPCI_C) ; Enable Tx interrupt SET 0,A ; OUT (pEPCI_C),A ; JP Int_Exit ; Done IR_Rx_Fail IN A,(pEPCI_C) ; Clear errors SET 4,A ; OUT (pEPCI_C),A ; Clear RES 4,A ; OUT (pEPCI_C),A ; Normal JR IR_Rx_Kill_Mess ; Kill the message Rx_StoreByte LD C,A ; Save byte LD HL,(pRx_In) ; Get ptrs LD A,L ; Step input ptr to next space INC A ; CP H ; Buffer full ? JR Z Rx_SB_Full ; Yes, Fail LD (pRx_In),A ; Save stepped ptr LD H,Rx_Buffer/256 ; Add base LD (HL),C ; Store byte OR A ; No errors RET ; Done Rx_SB_Full SCF ; Assert fail RET ; Fail ; Make A a valid checksum char Make_Checksum CP #20 ; NOB ? RET NC ; No, valid ADD A,#80 ; Make valid RET ; Done ; Transmit interrupt IR_Send LD A,(Tx_Ack_Flag) ; Must send ACK ? OR A ; JR Z IR_1 ; No, send message XOR A ; Stop sending LD (Sending_Flag),A ; LD (Tx_Ack_Flag),A ; Kill flag LD A,cACK ; Send ACK OUT (pEPCI_D),A ; JP Int_Exit ; Done IR_1 LD A,(Rec_Count) ; Receiving a message ? OR A ; JR NZ IR_1_Stop ; Yes, stop transmitting LD A,(Sending_Flag) ; Sending a message ? OR A ; JR NZ IR_2 ; Yes, send next char LD A,(nTx_Mess) ; Any to send ? OR A ; JR NZ IR_3 ; Yes, start next one IR_1_Stop IN A,(pEPCI_C) ; Kill Tx interrupt RES 0,A ; OUT (pEPCI_C),A ; JP Int_Exit ; Done IR_3 LD A,3 ; Assert retry count LD (Tx_Retrys),A ; IR_2_Start LD A,1 ; Flag sending LD (Sending_Flag),A ; LD A,(pTx_Out) ; Get ptr to next message LD (pTx_Mess),A ; Store it IN A,(pEPCI_C) ; Start transmitter SET 0,A ; OUT (pEPCI_C),A ; IR_2 LD A,(pTx_Mess) ; Get ptr LD L,A ; Point INC A ; Step LD (pTx_Mess),A ; Save LD H,Tx_Buffer/256 ; Point at buffer LD A,(HL) ; Get char OR A ; End of message ? JR Z IR_2_ACK ; Yes, get an ACK OUT (pEPCI_D),A ; Send it LD (Dummy),A ; Flag sent JP Int_Exit ; Done ; Now wait for ACK IR_2_ACK IN A,(pEPCI_C) ; Kill transmitter RES 0,A ; OUT (pEPCI_C),A ; XOR A ; We need one sent now LD (Rx_Ack_Flag),A ; LD HL,Time_10ms ; Wait value IR_2_Lp EI ; Allow receiver interrupts NOP ; DI ; LD A,(Sending_Flag) ; Receiving a message ? OR A ; JP Z Int_Exit ; Yes, kill transmitting ; Tx disabled, is enabled when reciever finishes LD A,(Rx_Ack_Flag) ; ACK received ? OR A ; JR NZ IR_Next_Mess ; Yes, done DEC HL ; Time-out LD A,L ; Loop OR H ; JR NZ IR_2_Lp ; ; Failed to get an ACK LD A,(Tx_Retrys) ; Tried 3 times ? DEC A ; LD (Tx_Retrys),A ; JR NZ IR_2_Start ; No, try again IR_Next_Mess XOR A ; Not sending anymore LD (Sending_Flag),A ; LD A,(pTx_Mess) ; Skip this message LD (pTx_Out),A ; LD A,(nTx_Mess) ; Dec count DEC A ; LD (nTx_Mess),A ; IN A,(pEPCI_C) ; Enable transmitter SET 0,A ; OUT (pEPCI_C),A ; JP Int_Exit ; Done Init_Keys LD HL,Key_Debounce ; Clear counts LD B,6*4 ; IK_Lp LD (HL),#10 ; Kill it INC HL ; DJNZ IK_Lp ; Loop RET ; Done Read_Key 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_Debounce ; 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 scan-code for now RK_Done POP IX ; Restore RET ; ScanKeys PUSH HL ; Save regs PUSH DE ; PUSH BC ; LD HL,Key_Debounce ; De-bounce data LD E,0 ; No key pressed LD B,4 ; Number of scan-lines LD C,%00 111110 ; Scan line number SK_Lp PUSH BC ; Save scanline LD A,C ; Calc line AND %00 111111 ; 6 bits are significant OR pKBD ; OR in address LD C,A ; Replace IN A,(C) ; Read keys LD D,A ; Save it LD B,6 ; Do six 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 %0000 1111 ; 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 3,A ; Max JR NC 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 POP BC ; Restore scan addr SCF ; Next scan line RL C ; DJNZ SK_Lp ; Loop LD A,E ; Get found flag POP BC ; Restore regs POP DE ; POP HL ; RET ; Done Pause PUSH HL ; Delay PUSH BC P_Lp CPI ; Loop JP V P_Lp ; POP BC ; Restore POP HL ; RET ; Done Assert_Page PUSH BC ; Save PUSH AF ; LD C,A ; Preserve page LD A,31 ; Wait for blank OUT (pCRTC_A),A ; AP_Lp1 IN A,(pCRTC_D) ; Get status BIT 1,A ; VBlank JR NZ AP_Lp1 ; Wait if active AP_Lp2 EI ; Interlock NOP ; DI ; IN A,(pCRTC_D) ; Get status BIT 1,A ; VBlank JR Z AP_Lp2 ; Wait till active LD A,#0D ; Low order address OUT (pCRTC_A),A ; LD A,C ; Write data AND %000000 01 ; Get LSB RRCA ; Bit 7 OUT (pCRTC_D),A ; LD A,#0C ; High order address OUT (pCRTC_A),A ; LD A,C ; Giz it AND %000000 10 ; Get MSB RRCA ; Bit 0 OUT (pCRTC_D),A ; EI ; OK again POP AF ; Restore POP BC ; RET ; Done Assert_Deselect LD C,1 ; Set flag JR AND_1 ; Try it Negate_Deselect LD C,0 ; Set flag AND_1 LD A,(Deselect_Mode) ; Test flag CP C ; Same ? RET Z ; Yes, ignore LD A,C ; Set new state LD (Deselect_Mode),A ; JP Write_All_Keys ; Update them ; A = Key number (0..39) ; IX := Key data address Get_Key_Ptr PUSH HL ; Save PUSH BC ; LD L,A ; 16-bit LD H,0 ; ADD HL,HL ; * 16 ADD HL,HL ; ADD HL,HL ; ADD HL,HL ; LD BC,Key_Data_Tab ; Base of table ADD HL,BC ; Addr PUSH HL ; IX := Addr POP IX ; POP BC ; POP HL ; RET ; ; A = Key no. ; HL := Display addr Calc_pScreen CP 24 ; Valid ? CCF ; Return C if fail RET C ; No, fail ADD A,A ; Word long ADD A,pScreen_Tab & #FF; Look it up LD L,A ; ADC A,pScreen_Tab/256 ; SUB L ; LD H,A ; LD A,(HL) ; Read address INC HL ; LD H,(HL) ; LD L,A ; OR A ; Valid RET ; ; Make a key number into a return key number Convert_Key_Code CP 21 ; Normal key ? JR NC CKC_Scratch ; No, find it ADD A,#80-1 ; Assume page 0 LD C,A ; Save LD A,(Current_Page) ; Page 0 ? OR A ; JR Z CKC_0 ; Yes, done LD A,20 ; No, step 20 ADD A,C ; LD C,A ; CKC_0 LD A,C ; Get value OR A ; Done, OK RET ; CKC_Scratch SUB #80 ; Make 1..3 LD C,A ; Save key no. CALL Get_Scr_Ptr ; IX := ptr to scratch list CKC_Lp LD HL,(IX+dkpNext_Scr) ; Point at next key LD A,L ; End ? OR H ; JR Z CKC_Fail ; Yes, Not found PUSH HL ; Load ptr POP IX ; LD A,(IX+dkScr_Y) ; This one ? CP C ; JR NZ CKC_Lp ; No, loop LD BC,Key_Data_Tab ; Calc offset OR A ; SBC HL,BC ; SRA H ; /4 RR L ; SRA H ; RR L ; LD A,L ; 0..160 RRCA ; RRCA ; AND %00 111111 ; 0..39 OR #80 ; Calc key code RET ; Done (OK) CKC_Fail SCF ; Done (Fail) RET ; ; A := Status 0..1F ; (IX) = Key data Alter_Key_Status AND %00 0 11111 ; Mask out CP %00 0 01111 ; Deselect ? JR Z AKS_Des ; Yes CP %00 0 01101 ; Reselect ? JR Z AKS_Res ; Yes CP %00 0 01110 ; FULL ? JR Z AKS_Full ; Yes LD C,A ; Save LD A,(IX+dkStatus) ; Get status AND %00 1 00000 ; Preserve Deselect flag OR C ; New status LD (IX+dkStatus),A ; RET ; Done AKS_Des SET 5,(IX+dkStatus) ; Set flag RET ; Done AKS_Res RES 5,(IX+dkStatus) ; Clear flag RET ; Done AKS_Full LD (IX+dkCount),Full_Count ; Setup count RET ; Done ; Look in table and return ptr to priority flag Get_pPriority ADD A,Priority_Map & #FF ; Check if priority LD L,A ; ADC A,Priority_Map / 256 ; SUB L ; LD H,A ; RET ; Done ; HL = ptr to block, BC = length, A = Fill byte Fill_Mem LD (HL),A ; Write byte CPI ; INC HL;DEC BC JP V Fill_Mem ; Loop RET ; Done Key_Codes DEFB #01,#02,#03,#04,#05,#80 ; Keys DEFB #06,#07,#08,#09,#0A,#81 DEFB #0B,#0C,#0D,#0E,#0F,#82 DEFB #10,#11,#12,#13,#14,#83 CRTC_Tab DEFB 120 ; Total chars (n-1) DEFB 120 ; All displayed DEFB 120 ; Sync on last char DEFB #11 ; Sync widths DEFB 0 ; Vertical total (n-1) DEFB 2 ; Vertical adjust DEFB 0 ; All displayed DEFB 0 ; End of first line DEFB %00 00 00 00 ; Modes DEFB 23 ; Lines per char (n-1) DEFB 0,0 ; Cursor reg DEFB %000 00000 ; High Screen address DEFB %00000000 ; Low DEFB 0,0 ; Cursor addr DEFB 0,0 ; Light pen DEFB 100 ; Screen 2 start (dummy) DEFB 0,0 ; address DEFB 100 ; Screen 3 start DEFB 0,0 ; addr DEFB 100 ; Screen 4 start DEFB 0,0 ; addr DEFB 0 ; VSync adjust DEFB 0 ; Light pen DEFB 0 ; Smooth scroll register DEFB %0 0 00 0 0 00 ; Control reg 1 DEFB %0 0 0 0 0 000 ; Control 2 DEFB %0 0 0 0 0 1 0 0 ; Control 3 DEFB 0 ; Memory width register DEFB 0,0 ; Cursor 2 DEFB 0,0 ; Cursor 2 addr DEFB 0,0 ; Cursor widths ; Offsets to status definition dText_Flags EQU 0 ; Offsets to data fields dLocal_Flags EQU 1 ; dpLocal EQU 2 ; dArea_Flags EQU 4 ; dAI_Flags EQU 9 ; dAI_Offset EQU 10 ; dAI_Text EQU 11 ; ; Offsets to keys' data dkText EQU 0 ; Make pointing easier dkStatus EQU 8 ; dkCount EQU 9 ; FULL count dkScr_Y EQU 10 ; Which scratch area dkpNext_Scr EQU 11 ; List ptr dkLength EQU 16 ; Nice number (Don't change !) AI_Clear DEFB %0 0 0 0 0 ; LA DEFB %1 0 0 0 0 ; AI DEFB %0 0 0 0 0 ; AI 1 DEFB %0 0 0 0 0 ; AI 2 DEFB %0 0 0 0 0 ; AI 3 All_Clear DEFB %1 0 0 0 0 ; LA DEFB %1 0 0 0 0 ; AI DEFB %0 0 0 0 0 ; AI 1 DEFB %0 0 0 0 0 ; AI 2 DEFB %0 0 0 0 0 ; AI 3 Status_Tab DEFW stC0 ; C0 DEFW stC0 ; DEFW stC2 ; DEFW stC3 ; DEFW stC4 ; DEFW stC5 ; DEFW stC2 ; DEFW stC0 ; DEFW stC8 ; DEFW stC9 ; DEFW stCA ; DEFW stCB ; DEFW stCC ; DEFW stNC ; DEFW stCE ; DEFW stNC ; DEFW stD0 ; D0 DEFW stC4 ; DEFW stCB ; DEFW stD3 ; DEFW stD4 ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stC0 ; Deselected state DEFW stC0d ; C0 DEFW stC0d ; DEFW stC2d ; DEFW stC3d ; DEFW stC4d ; DEFW stC5d ; DEFW stC2d ; DEFW stC0d ; DEFW stC8d ; DEFW stC8d ; DEFW stC8d ; DEFW stCB ; DEFW stCC ; DEFW stNC ; DEFW stCE ; DEFW stNC ; DEFW stC2d ; D0 DEFW stC4d ; DEFW stCB ; DEFW stD3 ; DEFW stD4 ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stNC ; DEFW stC5 ; Selected state stNC DEFB %1 1 1 1 1 ; Text flags DEFB %0 0 0 0 0 ; Local text flags DEFW 0 ; Local text ptr DEFB %1 0 0 0 0 ; Area fill flags DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; AI Flags DEFB 5 ; Pixel shift DEFB 0 ; Text stC0 DEFB %1 1 1 1 1 ; Text flags DEFB %0 0 0 0 0 ; Local text flags DEFW 0 ; Local text ptr DEFB %1 0 0 0 0 ; Area fill flags DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; AI Flags DEFB 5 ; Pixel shift DEFB 0 ; Text stC2 DEFB %1 0 1 0 1 ; Text flags DEFB %0 0 0 0 0 ; Local text flags DEFW 0 ; Local text ptr DEFB %1 0 0 0 0 ; Area fill flags DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; AI Flags DEFB 0 ; Pixel shift DEFB 0 ; Text stC3 DEFB %1 0 1 0 1 ; DEFB %1 1 0 1 0 ; DEFW sPRIORITY ; DEFB %1 1 0 1 0 ; DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB 5 ; DEFB 0 ; stC4 DEFB %1 0 1 0 1 ; DEFB %1 1 0 1 0 ; DEFW sOVERRIDE ; DEFB %1 1 0 1 0 ; DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB 0 ; DEFB 0 ; stC5 DEFB %1 1 1 1 1 ; DEFB %0 0 0 0 0 ; DEFW 0 ; DEFB %1 1 1 1 1 ; DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB 0 ; DEFB 0 ; stC8 DEFB %1 0 0 1 1 ; DEFB %0 0 0 0 0 ; DEFW 0 ; DEFB %1 0 0 1 1 ; DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB 0 ; DEFB 0 ; stC9 DEFB %1 0 0 1 1 ; DEFB %1 1 1 0 0 ; DEFW sPRIORITY ; DEFB %1 0 0 1 1 ; DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %1 1 1 0 0 ; DEFB %0 0 0 0 0 ; DEFB %1 1 1 1 1 ; DEFB 5 ; DEFB " P",0 ; stCA DEFB %0 0 0 0 0 ; DEFB %1 1 1 0 0 ; DEFW sOVERRIDE ; DEFB %1 0 0 1 1 ; DEFB %1 0 0 1 1 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB 0 ; DEFB 0 ; stCB DEFB %1 0 1 0 1 ; DEFB %0 0 0 0 0 ; DEFW 0 ; DEFB %1 0 0 0 0 ; DEFB %1 0 0 0 0 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 1 1 ; DEFB %1 0 1 0 1 ; DEFB 5 ; DEFB "T",0 ; stCC DEFB %1 1 1 1 1 ; DEFB %0 0 0 0 0 ; DEFW 0 ; DEFB %1 1 1 1 1 ; DEFB %1 0 0 0 0 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 1 1 ; DEFB %1 0 1 0 1 ; DEFB 5 ; DEFB "DV",0 ; stCE DEFB %1 0 1 0 1 ; DEFB %0 0 0 0 0 ; DEFW 0 ; DEFB %1 0 0 0 0 ; DEFB %1 1 1 1 1 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %1 1 1 1 1 ; DEFB 1 ; DEFB "FULL",0 ; stD0 DEFB %1 0 1 0 1 ; DEFB %1 1 0 1 0 ; DEFW sPRIORITY ; DEFB %1 1 0 1 0 ; DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB 0 ; DEFB 0 ; stD3 DEFB %1 0 1 0 1 ; DEFB %1 1 0 1 0 ; DEFW sOVERRIDE ; DEFB %1 1 0 1 0 ; DEFB %1 0 0 0 0 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 1 1 ; DEFB %1 0 1 0 1 ; DEFB 5 ; DEFB "T",0 ; stD4 DEFB %1 1 1 1 1 ; DEFB %0 0 0 0 0 ; DEFW 0 ; DEFB %1 1 1 1 1 ; DEFB %1 0 0 0 0 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 1 1 ; DEFB %1 0 1 0 1 ; DEFB 5 ; DEFB "DV",0 ; stC0d DEFB %1 1 1 1 1 ; DEFB %0 0 0 0 0 ; DEFW 0 ; DEFB %1 0 0 0 0 ; DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 1 1 ; DEFB 5 ; DEFB " D",0 ; stC2d DEFB %1 0 1 0 1 ; DEFB %0 0 0 0 0 ; DEFW 0 ; DEFB %1 0 0 0 0 ; DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 1 1 ; DEFB 5 ; DEFB " D",0 ; stC3d DEFB %1 0 1 0 1 ; DEFB %1 1 0 1 0 ; DEFW sPRIORITY ; DEFB %1 1 0 1 0 ; DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 1 1 ; DEFB 5 ; DEFB " D",0 ; stC4d DEFB %1 0 1 0 1 ; DEFB %1 1 0 1 0 ; DEFW sOVERRIDE ; DEFB %1 1 0 1 0 ; DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 1 1 ; DEFB 5 ; DEFB " D",0 ; stC5d DEFB %1 1 1 1 1 ; DEFB %0 0 0 0 0 ; DEFW 0 ; DEFB %1 1 1 1 1 ; DEFB %1 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %0 0 0 0 0 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 1 1 ; DEFB 5 ; DEFB " D",0 ; stC8d DEFB %1 1 1 1 1 ; DEFB %0 0 0 0 0 ; DEFW 0 ; DEFB %1 0 0 0 0 ; DEFB %1 0 0 0 0 ; DEFB %1 0 0 1 1 ; DEFB %1 0 0 1 1 ; DEFB %1 1 1 1 1 ; DEFB %1 1 1 0 0 ; DEFB 5 ; DEFB " D",0 ; Priority_Map DEFB 0,0,1,3,1,0,0,0 ; C2,C3,C4 DEFB 1,3,1,0,0,0,0,0 ; C8,C9,CA DEFB 2,0,0,0,0,0,0,0 ; D0 DEFB 0,0,0,0,0,0,0,0 ; sPRIORITY DEFM "PRIORITY" ; Displayed strings sOVERRIDE DEFM "OVERRIDE" ; sERROR DEFM "ERROR " ; sSELECT DEFM "SELECT " ; Fill_Data DEFB 0,16 ; Start offset, nlines DEFB #00,#01,#00,#FF,#00,#FF ; On DEFB #00,#FF,#00,#FE ; DEFB #00,#00,#00,#00,#00,#00 ; Off DEFB #00,#00,#00,#00 ; DEFB 16,8 ; LA1,2,3 DEFB #00,#01,#00,#FF,#00,#FF ; On DEFB #00,#FF,#00,#FE ; DEFB #00,#00,#00,#00,#00,#00 ; Off DEFB #00,#00,#00,#00 ; DEFB 16,8 ; LA1 DEFB #F9,#00,#FF,#00,#FF,#00 ; On DEFB #E0,#1F,#1E,#E0 ; DEFB #F9,#00,#FF,#00,#FF,#00 ; Off DEFB #E0,#00,#1E,#00 ; DEFB 16,8 ; LA2 DEFB #F9,#00,#FF,#00,#E0,#1F ; On DEFB #1F,#E0,#FE,#00 ; DEFB #F9,#00,#FF,#00,#E0,#00 ; Off DEFB #1F,#00,#FE,#00 ; DEFB 16,8 ; LA3 DEFB #F9,#00,#E0,#1F,#1F,#E0 ; On DEFB #FF,#00,#FE,#00 ; DEFB #F9,#00,#E0,#00,#1F,#00 ; Off DEFB #FF,#00,#FE,#00 ; Flash_State_Tab DEFB %00 ; Bit 0 = slow flash DEFB %10 ; 1 = fast flash DEFB %01 ; DEFB %11 ; DEFB #FF ; Guard pScreen_Tab DEFW #8000+115 ; Key addresses DEFW #8000+110 ; DEFW #8000+105 ; DEFW #8000+100 ; DEFW #8000+95 ; DEFW #8000+85 ; DEFW #8000+80 ; DEFW #8000+75 ; DEFW #8000+70 ; DEFW #8000+65 ; DEFW #8000+55 ; DEFW #8000+50 ; DEFW #8000+45 ; DEFW #8000+40 ; DEFW #8000+35 ; DEFW #8000+25 ; DEFW #8000+20 ; DEFW #8000+15 ; DEFW #8000+10 ; DEFW #8000+ 5 ; DEFW #8000+90 ; DEFW #8000+60 ; DEFW #8000+30 ; DEFW #8000+ 0 ; Identifier DEFM "Version 1.0 assembled on :- " ; TIMESTR ; This planted the editor's last change timestamp DEFM " (c) VAKO Displays LTD (0978-661201)" DEFM " Z80 Trained by KVM Systems (061-224-4283)" DEFM " And the motto of the piece is -" DEFM " 'Life is hard, and then you die' " DEFM " or 'Truth before Beauty'" DEFB #0D DEFM " This ROM is a work of fiction and any" DEFM " resemblance to any other ROM, current" DEFM " or obsolete, is purely co_incidental" DEFB #0D,#0D DEFM " Coming Soon To A DA Panel Near You !" DEFB #0D DEFM "DA PANEL 2 - The CAA strike back" DEFB #0D DEFM "In which our hero cures most of the bugs " DEFM "from version 1, whilst introducing some new bugs " DEFM "to the screen to prepare for Version 3" DEFB #0D,#0D,#1A Ident_End EQU $ ORG #4080 ; Leave some space for stack RamBott EQU $ Key_Debounce DEFS 6*4 ; De-bounce counts Flash_State DEFS 1 ; Current flash state Deselect_Mode DEFS 1 ; Flag for deselect Current_Page DEFS 1 ; Key page number Sel_State DEFS 1 ; Demand select state Old_Sel_State DEFS 1 ; Current select state cScratch_No DEFS 1 ; Number of scratch keys pScr_0 DEFS 2 ; Ptrs to scratch list pScr_1 DEFS 2 ; Temp_Scr_List DEFS 2 ; List ptr for update cKey_No DEFS 1 ; Temp. store cKey_Addr DEFS 1 ; Temp. store pTx_In DEFS 1 ; Input ptr to Rx buffer pTx_Out DEFS 1 ; Output pTx_Mess DEFS 1 ; Start of message pRx_In DEFS 1 ; Input ptr to Tx buffer pRx_Out DEFS 1 ; Output pRx_Mess DEFS 1 ; Start of message nRx_Mess DEFS 1 ; Number of recieved messages nTx_Mess DEFS 1 ; Number of transmitted messages Tx_Ack_Flag DEFS 1 ; Send an ACK char Rx_Ack_Flag DEFS 1 ; Recieved an ACK char Sending_Flag DEFS 1 ; Sending a message Tx_Retrys DEFS 1 ; No. of goes tried Rec_Count DEFS 1 ; Recieve character count Rx_Checksum DEFS 1 ; Recieve checksum Dummy DEFS 32 ; Dummy message area Slot_Buffer DEFS 4 ; Free slot list ORG ($ or #FF)+1 ; Next page boundary Rx_Buffer DEFS #100 ; Buffer for recieved chars Tx_Buffer DEFS #100 ; Buffer for transmitted chars Key_Data_Tab DEFS 40 * dkLength ; Data for key states