;============================================================================== ; simplified AMouse + keyboard only driver ;============================================================================== ; simplest possible demo with one icon (red square) for exit cpu z80undoc org 32768 START push iy ; some registers are needed for Sinclair BASIC exx push hl exx ld a,56 ; PAPER 7, INK 7 call CLS ; clear screen ld a,2*8 ; red PAPER, black ink ld (22528),a ; make red square 16x16px in top left corner ld (22528+1),a ; = simplest icon "exit" ld (22528+32),a ld (22528+33),a ld a,6 ; BORDER 6 out (254),a ld a,1 ; enable AMouse ld (MOUSE_HID),a ld hl,ICONS ; set address of icon table ld (MOUSE_ICONS),hl ; should contain at leas one icon ld hl,KEYTAB ; set address of table, where are defined control keys ld (MOUSE_KEYTAB),hl jp CALLMOUSE ; call mouse driver EXIT exx ; return to Sinclair BASIC pop hl exx pop iy ret ;-------------------------------------------------------------------------------------------------- ICONS db 0,16,0,16 ; x1,x2,y1,y2 - area where icon is dw EXIT ; address where to jump if clicked on icon db 255 ; end of table ; Every item in these tables is composed from 5 bytes. First two are port address. ; For example 254+256*127 = 32766 which is io port for keys B, N, M, symbol shift and space ; Third byte is mask. Last two bytes is address determinig what code to call if key will be ; pressed. KEYTAB db 254, 223, 00000010b ; LEFT (O) dw MOUSE_KLEFT ; where call if key pressed db 254, 223, 00000001b ; RIGHT (P) dw MOUSE_KRIGHT db 254, 251, 00000001b ; UP (Q) dw MOUSE_KUP db 254, 253, 00000001b ; DOWN (A) dw MOUSE_KDOWN db 254, 127, 00000100b ; FIRE (M) dw MOUSE_KFIRE1 db 255 ; end of table ; This table can be defined for Kempson joystick too, but it doesn't make sense if ; AMouse is connected to the same port. Disable AMouse, redefine table and it will work. ; ; In table could be more keys with same function. For example OPQAM and Sinclair joystick 67890. ;================================================================================================== MOUSE_CHEIGHT equ 13 ; height of pointer - all pointers have same height ;-------------------------------------------------------------------------------------------------- ; start of main loop MOUSE ld hl,128+96*256 ; cursor coordinates X in L, Y in H ld a,h ; copy cordinates ld c,l ; X -> C, Y -> A call 8880 ; from coordinates compute address in VRAM in HL ld (MOUSE_DRAW+1),hl ; set pattern for drawing ld (MOUSE_CLEAR+1),hl ; set pattern for erasing ld (MOUSE_DRAW_2+1),a ; set, how many rotations subtract from 8 call MOUSE_DRAW ; draw cursor on screen ;------------------------------------------------------------------------------ ; change coordinates of mouse cursor by keyboard MOUSE_KEYBOARD ld ix,MOUSE_DUMMY_TAB ; get address of table with defined keys ld hl,(MOUSE_XY) ; get cursor coordinates in HL xor a ld (MOUSE_RKEYS_JR+1),a ; modify address in relative jump to MOUSE_RKEYS ld d,a ; set D = 0, default a state of buttons = nothing pressed (yet) ld e,a ; set E = 0, it has no use in this driver call MOUSE_READKEYS ; process whole key table ld (MOUSE_XY),hl ; store new coordinates ld a,d ld (MOUSE_BUTTONS),a ; store new buttons status ; keyboard processed - continue with real mouse if enabled ; ; MOUSE_HID ; 0 = only keyboard ; 1 = keyboard + AMouse MOUSE_HIDLD ld a,0 ; is AMouse enabled? or a jp nz,MOUSE_AMOUSE ; NZ = jump to AMouse driver MOUSE_COMMON ei ; enable interrupt (just for any case) halt ; and wait for interrupt (1/50s when picture is starting on TV screen) call MOUSE_CLEAR ; remove old cursor from screen MOUSE_FB_STATE ld a,0 ; get buttons status (FIRE BUTTONS, or HOTKEYS) or a ; 0 = check for zero (nothing pressed) ret nz ; NZ = something was pressed -> return jr MOUSE ; repeat whole loop ;-------------------------------------------------------------------------------------------------- ; these subroutines are called by table of control keys MOUSE_KFIRE1 set 0,d ; fire 1 was pressed - set bit 0 ret MOUSE_KLEFT ld a,l ; get X coordinate in A sub c ; subtract step size ld l,a ; store new X coordinate back ret nc ; NC = no correction is needed ld l,0 ; left border was crossed, correct it ret MOUSE_KRIGHT ld a,l ; get X coordinate in A add a,c ; add step size ld l,a ; store new X coordinate back ret nc ; NC = no correction is needed ld l,254 ; right border was crossed, correct it ret MOUSE_KUP ld a,h ; get Y coordinate in A sub c ; subtract step size ld h,a ; store new Y coordinate back ret nc ; NC = korekce není potřeba ld h,0 ; top border was crossed, correct it ret MOUSE_KDOWN ld a,h ; get Y coordinate in A add a,c ; add step size ld h,a ; store new Y coordinate back cp 190 ; check if bottom border was crossed ret c ; C = no correction is needed ld h,190 ; bottom border was crossed, correct it ret ;-------------------------------------------------------------------------------------------------- ; MOUSE_READKEYS - universal code for processing table of ports and masks for keys or joystick ; need address of table in register IX ; doesn't affect registers HL & DE (HL contains coordinates, DE state of buttons and scroll wheel) MOUSE_READKEYS ld a,(ix+0) cp 255 ; 255 = end of table? ret z ; Z = end of table reached = return ld c,a ; read 16 bit address in register BC, will be port address ld b,(ix+1) in a,(c) ; read 16 bit io port bit 7,c ; try detect if port was keyboard or Kempston joystick ; for Kempston joystick should be bit 7 always 0 ; for keyboard should be bit 7 alwais 1 jr z,MOUSE_RKEYS_JOY ; Z = probably joystick cpl ; invert bits, for keyboard is pressed key = 0 MOUSE_RKEYS_JOY and (ix+2) ; now should be pressed key or joystick direction = 1, apply mask jr z,MOUSE_RKEYS_NXT ; Z = tested key not pressed ld c,(ix+3) ; address of code for tested key in BC ld b,(ix+4) ; this relative jump is switch for differen behavior for regular keys (directions, fire...) and hotkeys MOUSE_RKEYS_JR jr MOUSE_RKEYS ; relative address will be modified do MOUSE_RKEYS, or to MOUSE_RHKEYS ; regular keys for moving cursor etc. MOUSE_RKEYS ld (MOUSE_RKEYS_3+1),bc ; modify address in instruction CALL MOUSE_KSLD ld c,2 ; step size for cursor movement MOUSE_RKEYS_3 call MOUSE_RET ; call subroutine for pressed key MOUSE_RKEYS_NXT ld bc,5 ; 5 bytes per item in table add ix,bc ; compute address of next item in table jr MOUSE_READKEYS ; repeat MOUSE_RET ret ;------------------------------------------------------------------------------ ; change coordinates by AMouse ; ; will change these coordinates ; will change status of buttons on address MOUSE_BUTTONS if pressed MOUSE_AMOUSE ld bc,130*256 ; B = how many times read port every 1/50s (compromise), set C = 0 ld a,(MOUSE_X) ; copy coordinates in operands inside cycle ld (MOUSE_AM_X+1),a ld a,(MOUSE_Y) ld (MOUSE_AM_Y+1),a MOUSE_AM_LOOP push bc ; 11T store BC - here starts main loop for AMouse ld b,c ; 4T copy zero from C to B (zero will be returned every pass through loop from stack) in a,(31) ; 11T read AMouse (Kjoy) port ld de,MOUSE_AM_STAT ; 10T pointer to old status of mouse signals for X call MOUSE_AM_DIR ; 17T check which direction mouse moved MOUSE_AM_X ld a,0 ; 7T get X coordinate in A add a,(hl) ; 7T add value 0, +1 or -1 from table jr z,MOUSAKX ; 12/7T Z = left border reached or right border crossed, don't store new coordinate ld (MOUSE_AM_X+1),a ; 13T write new X coordinate MOUSAKX inc de ; 6T increment pointer to old status of mouse signals to Y in a,(31) ; 11T read AMouse (Kjoy) port rrca ; 4T rotate 1 bit right, to be able use same subroutine as for X call MOUSE_AM_DIR ; 17T check which direction mouse moved MOUSE_AM_Y ld a,0 ; 7T get Y coordinate in A add a,(hl) ; 7T add value 0, +1 or -1 from table jr z,MOUSAKY ; 12/7T Z = top border was reached, don't store new coordinate cp 190 ; 7T check if bottom border was crossed jr c,MOUSADO ; 12/7T C = mouse cursor is still above bottom border ld a,190 ; 7T make correction MOUSADO ld (MOUSE_AM_Y+1),a ; 13T write new Y coordinate MOUSAKY pop bc ; 10T restore BC djnz MOUSE_AM_LOOP ; 13/8T repeat B times ; total 11+4+11+10+17+75+7+7+7+13+6+11+4+17+75+7+7+7+7+12+13+10+13 = 351T most typical run (cca 10kHz) ld a,(MOUSE_AM_X+1) ; copy new coordinates from AMouse part to main "variable" ld (MOUSE_X),a ld a,(MOUSE_AM_Y+1) ld (MOUSE_Y),a in a,(31) ; last time read AMouse port rra ; move bits 4,5,6 for buttons to position of bits 0,1,2 rra rra rra and 00000001b ; leave only bit significant for button (can be up to three) ld b,a ; copy to register B ld a,(MOUSE_BUTTONS) ; read status of "fire" keys or b ; OR it with mouse buttons, ld (MOUSE_BUTTONS),a ; now can be used both at a same time jp MOUSE_COMMON ; this subroutine will combine old and new status of mouse signals and will return pointer in HL to value 0,+1,-1 MOUSE_AM_DIR and 00000101b ; 7T leave only bits for mouse signals ld c,a ; 4T store it in C ld a,(de) ; 7T read old state of mouse signals rlca ; 4T rotate left and 00001010b ; 7T and leave only these bits or c ; 4T combine with new state of mouse signals - now ve have number 0..15 ld (de),a ; 7T store result for future use ld c,a ; 4T copy it in C, B is already zero ld hl,MOUSE_AM_TAB ; 10T get pointer in "directions" table add hl,bc ; 11T add number 0..15 assembled from "new and old mouse signals" ret ; 10T ; total 7+4+7+4+7+4+7+4+10+11+10 = 75T MOUSE_AM_TAB db 0,255,1,0 ; table of values 0, +1, -1 for every possible db 1,0,0,255 ; combination of old and new mouse signals db 255,0,0,1 db 0,1,255,0 MOUSE_AM_STAT db 0 ; old status of mouse signals for axis X db 0 ; old status of mouse signals for axis Y ;-------------------------------------------------------------------------------------------------- ; cursor drawing - code heavily inspired by book "Assembler and ZX Spectrum II" from Proxima ;-------------------------------------------------------------------------------------------------- ; MOUSE_DRAW a MOUSE_CLEAR subroutines can be called any time without need set registers. ; MOUSE_DRAW will draw cursor on screen at same position as it was last time when was driver running. ; Buffer will be updated, so MOUSE_CLEAR can be called after that. MOUSE_DRAW ld hl,19472 ; pointer to the screen where mouse cursor should be MOUSE_CURLD ld ix,MOUSE_SPR_ARROW ; sprite address in IX (can be changed for another sprite) exx ld hl,MOUSE_BACKGRBUF ; buffer address in second HL, in buffer will be copied screen content exx ld b,MOUSE_CHEIGHT ; sprite height MOUSE_DRAW_1 push bc ; store height in stack push hl ; store screen pointer twice on stack push hl ld h,0 ; 0 in H, here will be rotated sprite/mask if needed ld l,(ix+0) ; read sprite in L ld d,h ; 0 in D ld e,(ix+MOUSE_CHEIGHT) ; read mask in E inc ix ; move pointer IX to next byte of graphics ld a,8 ; 8 in A (8 bits/rotations per byte) MOUSE_DRAW_2 sub 0 ; subtract number of rotations to the right ld b,a ; number of rotation to the left in B MOUSE_DRAW_3 add hl,hl ; HL *= 2 (rl HL) sla e ; DE *= 2 (rl DE) rl d djnz MOUSE_DRAW_3 ; repeat until B = 0 (up to 7 times) ex (sp),hl ; swap address of cursor on screen from stack to HL pop bc ; get rotated graphics of cursor into BC (was in HL originally) ld a,(hl) ; read original content of screen exx ; second set of registers ld (hl),a ; store original content of screen in buffer inc hl ; next byte in buffer exx ; primary set of registers ld a,d ; get left part of mask cpl ; invert it and (hl) ; remove pixels from background where mask had 0 or b ; add graphics of mouse cursor ld (hl),a ; store it back in screen inc l ld a,l and 00011111b ; was right border crossed? jr z,MOUSE_DRAW_4 ; Z = yes ld a,(hl) ; whole proccess repeat again for second byte exx ld (hl),a inc hl exx ld a,e cpl and (hl) ; remove pixels from background where mask had 0 or c ; add graphics of mouse cursor ld (hl),a MOUSE_DRAW_5 pop hl ; restore address of left byte in screen from stack call DOWNHL ; compute address one pixel down pop bc ; restore counter djnz MOUSE_DRAW_1 ; repeat for whole height of mouse cursor ret MOUSE_DRAW_4 exx inc hl ; only increment pointer to the buffer exx jr MOUSE_DRAW_5 ;-------------------------------------------------------------------------------------------------- ; clear cursor and replace it with original content of screen before mouse cursor was drawn ;-------------------------------------------------------------------------------------------------- MOUSE_CLEAR ld hl,16384 ; pointer to the screen where is placed mouse cursor ld b,MOUSE_CHEIGHT ; height of mouse cursor in pixelx ld de,MOUSE_BACKGRBUF ; address of buffer with original content MOUSE_CLEAR_1 ld a,(de) ; get byte from buffer ld (hl),a ; write it in screen inc de ; move DE to next byte in buffer push hl ; store HL inc l ld a,l and 00011111b ; was right border crossed? jr z,MOUSE_CLEAR_2 ; Z = yes, jump over processing second byte ld a,(de) ; get byte from buffer ld (hl),a ; write it in screen MOUSE_CLEAR_2 inc de ; move DE to next byte in buffer pop hl ; restore HL to address of left byte call DOWNHL ; compute address one pixel down djnz MOUSE_CLEAR_1 ; repeat for whole height of mouse cursor ret ;================================================================================================== ; graphics of some very basic cursors ;================================================================================================== MOUSE_SPR_ARROW db 00000000b ; classic arrow cursor db 01000000b db 01100000b db 01110000b db 01111000b db 01111100b db 01111110b db 01111000b db 01001000b db 00001000b db 00000100b db 00000100b db 00000000b db 11100000b ; mask db 11110000b db 11111000b db 11111100b db 11111110b db 11111111b db 11111111b db 11111111b db 11111100b db 11111110b db 00011110b db 00011110b db 00001110b MOUSE_BACKGRBUF ds MOUSE_CHEIGHT*2 ; buffer for part of screen where cursor was drawn ;================================================================================================== ; wait until any key is pressed include mouse buttons if selected ; PAUSE 0 because command in Sinclair BASIC with similar behaviour PAUSE0 call MOUSE_TESTFIRE jr z,PAUSE0 ; Z = no key or button was pressed, repeat ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; wait while any key is pressed include mouse buttons if selected PAUSENK call MOUSE_TESTFIRE jr nz,PAUSENK ; NZ = some key or button is pressed, repeat ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; common part for keys/buttons testing - returns Z if nothing pressed MOUSE_TESTFIRE xor a ; set port upper byte of address to zero in a,(254) ; read all keyboard ports at once cpl ; invert bits and 11111b ; leave only bits significant for keys ret nz ; NZ = a key was pressed, return, otherwise we will check mouse buttons ld a,(MOUSE_HID) ; is mouse control enabled? or a ; check for zero ret z ; Z = only keyboard is enabled, but fire is not pressed, return jr MOUSE_TSTBUTAM ; NZ = AMouse enabled, jump to test AMouse buttons MOUSE_TSTBUTAM in a,(31) ; AMouse left button, or Kempston Joystick fire button and 00010000b ; only bit for buttons (can be up to three buttons) ret ;================================================================================================== ; CALLMOUSE is the main entry point for program using this driver ;================================================================================================== ; See example how to use it. ; Basically call this code and it will jump to address defined in table for clicked icon or pressed hotkey. CALLMOUSE call MOUSE ; call main loop, it will draw mouse cursor ; until fire button will be pressed MOUSE_TSTXY ld de,(MOUSE_XY) ; read coordinates where user clicked in DE (D = X, E = Y) ld bc,6 ; size of item in BC (4 bytes coordinates, 2 bytes address) MOUSE_TSTXY_0 ld ix,MOUSE_DUMMY_TAB ; table address in IX jr MOUSE_TSTXY_FRS ; jump over first add MOUSE_TSTXY_NXT add ix,bc ; add size of intem BC and pointer to table IX MOUSE_TSTXY_FRS ld a,(ix+0) ; read coordinate X1 cp 255 ; is it end of table (255)? jr z,CALLMOUSE ; Z = end of table, user did not clicked on icon, but somewhere else cp e ; compare coordinates of cursor with coordinates from table jr nc,MOUSE_TSTXY_NXT ; NC = cursor is outside icon ld a,(ix+1) cp e jr c,MOUSE_TSTXY_NXT ; C = cursor is outside icon ld a,(ix+2) cp d jr nc,MOUSE_TSTXY_NXT ; NC = cursor is outside icon ld a,(ix+3) cp d jr c,MOUSE_TSTXY_NXT ; C = cursor is outside icon ld h,(ix+5) ; get address for this icon in HL ld l,(ix+4) jp (hl) ; and jump on that address ;================================================================================================== ; important addresses for this driver ;================================================================================================== ; compiler needs these values here, at end of code MOUSE_BUTTONS equ MOUSE_FB_STATE+1 ; button status (of not zero, button or key was pressed) MOUSE_X equ MOUSE+1 ; last known coordinates MOUSE_Y equ MOUSE+2 MOUSE_XY equ MOUSE+1 MOUSE_HID equ MOUSE_HIDLD+1 ; 0 = keyboard only, 1 = AMouse enabled MOUSE_KEYSTEP equ MOUSE_KSLD+1 ; KEYSTEP, step size for cursor movement by keyboard MOUSE_ICONS equ MOUSE_TSTXY_0+2 ; address where set pointer to icon table MOUSE_KEYTAB equ MOUSE_KEYBOARD+2 ; address where set pointer to table of control keys MOUSE_DUMMY_TAB equ 15360 ; it points in ROM, where should be 255 = end of table ; MOUSE_DUMMY_TAB should be always replaced by real address ;================================================================================================== ; compute address on screen one pixel down under current address ; This is usualy part of program which is using this driver DOWNHL inc h ld a,h and 7 ret nz ld a,l add a,32 ld l,a ld a,h jr c,DOWNHL2 sub 8 ld h,a DOWNHL2 cp 88 ret c ld h,0 ; if bottom margin was reached draw sprite in read only ROM ret ;-------------------------------------------------------------------------------------------------- ; clear screen - short and slow CLS ld (CLS_2+1),a ld hl,16384 ld de,16385 ld bc,6144 ld (hl),0 ldir ; fill pixels with zeroes ld bc,767 CLS_2 ld a,56 ; colors - 0*128 + 0*64 + 8*7 + 0 = FLASH 0, BRIGHT 0, PAPER 7, INK 0 ld (hl),a ldir ; fill color attributes ret ;================================================================================================== ; Chips 8255 (clones of Intel 8255) are often used for paralell interface compatible with ; Kempston joystick. Normally after reset it have all 3 ports set as input, but sometimes it ; need to be set again. You can do it by this code. SET8255INPUT ld a,155 ; all ports as input (default state after reset) out (127),a ret ; Standard decimal addresses are ; ; 31 - io port ; 63 - io port ; 95 - io port ; 127 - control port ; ;==================================================================================================