FORTH EMPTY C? FREE CD :/SYS LOAD MOUSE FORGET EMPTY CD :/SYS LOAD Q_SPRITES CD : C ' MOD D# ' MOUSE ' ATTRIBUTE ' ABORT ' . ' SPRITE ' sprite ' PUT ' COUNT ' TYPE ' 3DROP ' PANEL H ASSEMBLE HERE EQU STACK PANEl EQU STACK DROP3 EQU STACK TYPE EQU STACK COUNT EQU STACK PUT EQU STACK sprite EQU STACK SPRITE EQU STACK POINT EQU STACK ABORT EQU STACK ATTRIBUTE EQU STACK MOUSE EQU STACK DRV_N EQU STACK MOD EQU STACK CURSOR EQU #5B9A ATTR EQU #5BA0 PUT_HL EQU 8 PRINT EQU #10 PUT_AA EQU #18 GET_AA EQU #20 P_DEHL EQU #28 GET_HL EQU #30 alert LD A,(X) LD (XX),A LD A,(Y) LD (YY),A LD A,(ATTR) LD (AA),A EX (SP),IY LD H,0 LD L,(IY+1) RST PUT_HL LD L,(IY+2) RST PUT_HL LD L,(IY+3) RST PUT_HL LD L,(IY+4) RST PUT_HL LD L,H BIT 7,(IY+0) JR NZ,n_restr LD HL,(HERE) n_restr RST PUT_HL LD H,0 LD L,(IY+5) RST PUT_HL LD L,(IY+6) RST PUT_HL CALL PANEL LD HL,(CURSOR) LD (TOPLFT),HL BIT 7,(IY+0) CALL NZ,DROP3 LD L,(IY+7) LD H,(IY+8) LD (A_PIC),HL LD DE,9 ADD IY,DE LD (OB1),IY XOR A LD (OBJ),A nx_obj BIT 7,(IY+0) JP Z,terminate BIT 5,(IY+0) JR Z,unsel LD HL,OBJ INC (HL) unsel BIT 1,(IY+0) JR Z,o_spr CALL iADDR BIT 0,(IY+0) JR Z,string CALL split LD HL,1 RST PUT_HL LD HL,0 ADDRi EQU $-2 LD A,(HL) EX AF,AF XOR A RST PUT_AA XOR A RST PUT_AA CALL PUT_CRS CALL PAN JR outtext string CALL SET_CRS \ inverse \ outtext RES 3,(IX+3) LD A,(IY+3) LD (ATTR),A BIT 6,(IY+0) JR Z,com SET 7,(IX-1) com LD HL,(ADDRi) RST PUT_HL CALL COUNT CALL TYPE RES 7,(IX-1) JR to_nx o_spr BIT 6,(IY+0) JR Z,coms CALL split LD HL,1 BIT 0,(IY+0) JR Z,small ADD HL,HL small RST PUT_HL ADD HL,HL RST PUT_HL LD L,H RST PUT_HL CALL PUT_CRS CALL PAN coms LD HL,(TOPLFT) LD A,H EX AF,AF XOR A RST PUT_AA LD A,L EX AF,AF XOR A RST PUT_AA LD A,(IY+1) ADD A,H CALL y_pix LD (Y),A LD A,L SRL A ADD A,(IY+2) ADD A,A ADD A,A ADD A,A LD (X),A LD HL,BUF RST PUT_HL INC HL LD (HL),0 CALL iADDR RST PUT_HL BIT 0,(IY+0) CALL sprSPR CALL ATTRIBUTE RST GET_HL LD A,(IY+3) LD (HL),A BIT 0,(IY+0) JR Z,to_nx INC L LD (HL),A LD DE,32 ADD HL,DE LD (HL),A DEC L LD (HL),A to_nx LD DE,6 ADD IY,DE JP nx_obj return LD (RESULT),A retres LD IY,(OB1) BIT 7,(IY-9) JR NZ,done RST GET_AA LD HL,(HERE) RST PUT_HL CALL PUT done LD HL,0 RESULT EQU $-2 RST PUT_HL LD A,0 AA EQU $-1 LD (ATTR),A LD A,0 YY EQU $-1 LD (Y),A LD A,0 XX EQU $-1 LD (X),A RET terminate INC IY EX (SP),IY LD A,0 OBJ EQU $-1 OR A JR Z,return LD IY,0 OB1 EQU $-2 XOR A LD (BUF+1),A LD A,(IY-3) SUB 2 ADD A,A ADD A,A LD (_LT),A LD A,(IY-4) INC A ADD A,(IY-6) CALL y_pix LD (_BOT),A LD A,(IY-5) ADD A,4 ADD A,A ADD A,A LD (_WIDTH),A LD A,(IY-6) ADD A,2 ADD A,A ADD A,A ADD A,A LD (_HEIGHT),A LD HL,sprite BIT 6,(IY-9) JR Z,sav2spr LD HL,SPRITE sav2spr LD (SPRITER),HL LD HL,0 TOPLFT EQU $-2 SRL L DEC H DEC L ADD HL,HL ADD HL,HL ADD HL,HL LD A,L ADD A,2 LD (X),A LD A,189 SUB H LD (Y),A step CALL corcor LD HL,BUF RST PUT_HL LD HL,0 A_PIC EQU $-2 \address of the cursor bitmap\ RST PUT_HL CALL 0 SPRITER EQU $-2 CALL MOUSE RST GET_AA EX AF,AF OR A JP Z,no_but LD IY,(OB1) LD HL,(TOPLFT) LD A,(X) SRL A SRL A SUB L SRL A LD E,A LD A,(Y) SUB 192 NEG SRL A SRL A SRL A SUB H LD D,A \DE= mouse attr rel coords\ XOR A nx_tst INC A LD (RESULT),A BIT 5,(IY+0) JR Z,n_tst LD B,(IY+1) LD C,(IY+2) BIT 1,(IY+0) JR Z,t_spr CALL iADDR LD A,(HL) SRL A DEC A ADD A,C LD L,A LD H,B BIT 0,(IY+0) CALL NZ,expand JR tester t_spr LD H,B LD L,C BIT 0,(IY+0) CALL NZ,enlarg BIT 6,(IY+0) CALL NZ,expand tester CALL t_box JR C,n_tst RST GET_AA RST GET_AA JP retres n_tst LD BC,6 ADD IY,BC BIT 7,(IY+0) LD A,(RESULT) JR NZ,nx_tst no_but CALL sc LD C,A LD A,(X) ADD A,C LD (X),A CALL sc LD B,A LD A,(Y) ADD A,B LD (Y),A JP step crs LD HL,(TOPLFT) LD A,H ADD A,(IY+1) LD D,A LD A,(IY+2) ADD A,A ADD A,L LD E,A RET PUT_CRS CALL crs LD H,0 LD L,D RST PUT_HL LD L,E RST PUT_HL RET SET_CRS CALL crs LD (CURSOR),DE RET split LD B,(IY+3) LD A,B LD (ATTR),A AND 7 EX AF,AF RST PUT_AA LD A,B RRCA RRCA RRCA AND #1F EX AF,AF RST PUT_AA RET PAN CALL PANEL JP DROP3 PANEL PUSH IY CALL PANEl POP IY RET iADDR LD L,(IY+4) LD H,(IY+5) LD (ADDRi),HL RET sprSPR JP Z,sprite JP SPRITE corcor \coords correction\ LD A,(X) LD HL,_LT SUB (HL) JR NC,XPEH_X LD HL,_WIDTH ADD A,(HL) XPEH_X EX AF,AF XOR A RST PUT_AA LD HL,0 _WIDTH EQU $-2 RST PUT_HL CALL MOD CALL GET_HL LD A,0 _LT EQU $-1 ADD A,L LD (X),A LD A,(Y) LD HL,_BOT SUB (HL) JR NC,XPEH_Y LD HL,_HEIGHT ADD A,(HL) XPEH_Y EX AF,AF XOR A RST PUT_AA LD HL,0 _HEIGHT EQU $-2 RST PUT_HL CALL MOD CALL GET_HL LD A,0 _BOT EQU $-1 ADD A,L LD (Y),A RET \ Byte parameters (in pixels): _LT, _WIDTH, _BOT, _HEIGHT \ y_pix ADD A,A ADD A,A ADD A,A SUB 192 NEG RET sc RST GET_AA EX AF,AF LD E,A LD A,(DRV_N) CP 2 LD A,E RET NC ADD A,A RET t_box \BC=box t-l; DE=mouse; HL=box b-r\ LD A,D CP B RET C LD A,H CP D RET C LD A,E CP C RET C LD A,L CP E RET \CF=0, if mouse in the box\ expand DEC B DEC C enlarg INC H INC L RET BUF DEFS 80 \Buffer for the cursor sprite\ ; CODE & ASSEMBLE LD HL,alert JP PUT_HL ; & FORGET & HEX : ALERT 0CD C, LITERAL , ; DECIMAL IMMEDIATE REMEMBER EMPTY CODE & ASSEMBLE LD HL,METKA CYKA LD A,(HL) EX AF,AF INC HL LD A,(HL) RST PUT_AA INC HL LD B,A EX AF,AF OR B JR NZ,CYKA RST GET_AA RET METKA DEFW PRINT,PUT_AA,GET_AA,P_DEHL,GET_HL DEFW alert,corcor,_LT,_WIDTH,_BOT,_HEIGHT,y_pix,sc,t_box,0 ; & FORGET & ASSEMBLE CLEAR t_box EQU STACK sc EQU STACK y_pix EQU STACK _DY EQU STACK _Y0 EQU STACK _DX EQU STACK _X0 EQU STACK corcor EQU STACK alert EQU STACK GET_HL EQU STACK P_DEHL EQU STACK GET_AA EQU STACK PUT_AA EQU STACK PRINT EQU STACK PUT_HL EQU 8 ;