; STREAMS AND CHANNELS by Toni Baker ; ZX Computing December 1986 ; ================================== ; JGH: Source recreated from JimG's transcription of code listing. ; Added channel documentation. ; JGH: Added a bug-fix to OPEN_NEW, added entry block with fixed entry points. ; ROM ADDRESSES ; ------------- UNPAGE EQU #0700 PO_GR_1 EQU #0B38 P_TUDG EQU #0B52 PO_SPACE EQU #0C39 REPORT_D EQU #0D00 COPY_L_2A EQU #0F12 ADD_CHAR_1 EQU #0F85 ED_ERROR EQU #107F REPORT_J EQU #15C4 CALL_JUMP EQU #162C MAKE_ROOM EQU #1655 STR_DATA_A EQU #1721 RECLAIM_2 EQU #19E8 REPORT_B EQU #1E9F BREAK_KEY EQU #1F54 ; SYSTEM VARIABLES ; ---------------- SWAP EQU #5B00 RETADDR EQU #5B5A BANK_M EQU #5B5C N_STR1 EQU #5B67 TVDATA EQU #5C0E TVDATAhi EQU -43 TVDATAlo EQU -44 STRMS_00 EQU #5C16 CHARS EQU #5C36 FLAGS EQU #5C3B ERR_SP EQU #5C3D CHANS EQU #5C4F CURCHL EQU #5C51 PROG EQU #5C53 FLAGX EQU 55 UDG EQU #5C7B MEMBOT EQU #5C92 SPECTRUM EQU #A3 RND EQU #A5 ; CHANNEL INFORMATION BLOCKS ; -------------------------- ; Short channel block (first four blocks in CHANS area) ; IX+00 (2 bytes): Address of PRINT# routine ; IX+02 (2 bytes): Address of INPUT# routine ; IX+04 (1 byte) : Name of channel (ASCII character code) ; Long channel block (any subsequent block in CHANS) ; IX+00 (2 bytes): Address of PRINT# routine or #0008 for Interface 1 channel ; IX+02 (2 bytes): Address of INPUT# routine or #0008 for Interface 1 channel ; IX+04 (1 byte) : Name of channel (ASCII character code). ; IX+05 (2 bytes): Address of Interface 1 PRINT# routine or #1234 identifier ; IX+07 (2 bytes): Address of Interface 1 INPUT# routine or CLOSE# routine ; IX+09 (2 bytes): Length of channel information block (minimum #000B). ; IX+0B onwards : Any additional information. ; CHANNEL "W" WINDOW INFORMATION ; ------------------------------ ; All window channels: W_OUT EQU #00 ; Address of WINDOW output routine (=WINDOW) W_IN EQU #02 ; Address of WINDOW input routine (=REPORT_J) W_NAME EQU #04 ; Name of channel (="W") W_IDEN EQU #05 ; New channel identifier (=#1234) W_CLOSE EQU #07 ; Address of empty buffer routine ; (EMPTY_2 for Slow windows or RET for Fast windows) W_CHLEN EQU #09 ; Length of channel information block W_FLAGS EQU #0B ; Various flags, defined as follows: ; Bit 7: Set if leading space not reqd. for keywords, reset otherwise ; Bit 6: Not used ; Bit 5: Set if scroll pause enabled, reset otherwise ; Bit 4: Set for Slow window, reset for Fast window ; Bit 3: Set for INVERSE 1, reset for INVERSE 0 ; Bit 2: Set if using double height, reset otherwise ; Bits 1,0: Number of control parameters required W_XCOORD EQU #0C ; Current x coordinate of print position W_WIDTH EQU #0D ; Number of characters per line W_YCOORD EQU #0E ; Current y coordinate of print position W_HEIGHT EQU #0F ; Height of window, in squares W_PRPOS EQU #10 ; Address within screen of current print position W_PRPOSlo EQU W_PRPOS+0 W_PRPOShi EQU W_PRPOS+1 W_HOME EQU #12 ; Address within screen of top left-hand corner of window W_HOMElo EQU W_HOME+0 W_HOMEhi EQU W_HOME+1 W_ATTR EQU #14 ; Colours currently being used for window W_SCROLLS EQU #15 ; Counts number of scrolls allowed before scroll pause, +1 ; ; "Slow" window channels: W_PIX EQU #16 ; Position within square of current print position W_CH_WID EQU #17 ; Width of characters, in pixels W_CHARS EQU #18 ; Address of character set (20-7F) minus #100 W_CHARSlo EQU W_CHARS+0 W_CHARShi EQU W_CHARS+1 W_UDG EQU #1A ; Address of character set (80-A4) W_UDGlo EQU W_UDG+0 W_UDGhi EQU W_UDG+1 W_WIDTH_8 EQU #1C ; Width of window, in squares W_LEN EQU #1D ; Number of characters stored in buffer W_BUFFER EQU #1E ; The buffer itself ; CHANNEL "Z" ZX PRINTER INFORMATION ; ---------------------------------- Z_OUT EQU #00 ; Address of channel "Z" output Z_IN EQU #02 ; Address of channel "Z" input Z_NAME EQU #04 ; Name of channel (="Z") Z_IDEN EQU #05 ; Constant #1234 identifies new channel Z_CLOSE EQU #07 ; Address of close buffer routine Z_LEN EQU #09 ; Length of channel info (ie. #010E) Z_FLAGS EQU #0B ; Various flags ; Bit 7: Set if leading space not reqd. for keywords, reset otherwise ; Bit 6: Not used ; Bit 5: Not used ; Bit 4: Not used ; Bit 3: Set for INVERSE 1, reset for INVERSE 0 ; Bit 2: Set if OVER status is ON, reset otherwise ; Bits 1,0: Number of control parameters required Z_XCOORD EQU #0C ; X coordinate of print position in buffer Z_WIDTH EQU #0D ; Width of buffer (ie. #20) Z_BUFFER EQU #0E ; New printer buffer (#100 bytes) ; CHANNEL "R" RAMDISC INFORMATION ; ------------------------------- R_OUT EQU #00 ; Address of RAMdisc file output routine (=R_PRINT) R_IN EQU #02 ; Address of RAMdisc file input routine (=R_INPUT) R_NAME EQU #04 ; Name of channel (="R") R_IDEN EQU #05 ; New channel identifier (=#1234) R_CLOSE EQU #07 ; Address of RAMdisc file close routine (=R_FLUSH) R_LEN EQU #09 ; Length of channel information block (=#021B) R_CHFLAG EQU #0B ; Various flags, defined as follows: ; Bits 7-2: Not used ; Bit 1: Set if End-Of-File at end of record, reset otherwise ; Bit 0: Reset for a READ file, set for a WRITE file R_CHBYTE EQU #0C ; Pointer into buffer R_CHREC EQU #0E ; Record number within file R_CHNAME EQU #0F ; File name R_RECLEN EQU #19 ; Length of record within buffer R_BUFFER EQU #1B ; Buffer storing current record ; CATALOGUE INDEX INFORMATION ; --------------------------- SF_NAME EQU #00 ; File name SF_START EQU #0A ; Page-coded address of start of file SF_LEN EQU #0D ; Total number of bytes in file, including header info SF_END EQU #10 ; Page-coded address of byte beyond end of file SF_FLAG EQU #13 ; Reset unless catalogue information incomplete ; (ie. reset normally) SF_NEXT EQU #5B83 START EQU #F000 ; Arbitary start, can be anywhere convenient ORG START ; Code is slightly under #B00 bytes long ; ENTRY JUMP BLOCK ; ---------------- ; On entry, A=stream, other registers=any other parameters CLOSE JP XCLOSE ; base+#00 Close stream A CREATE JP OPEN_NEW1 ; base+#03 Create a new channel OPEN_W JP W_OPEN ; base+#06 Open a Window channel OPEN_Z JP Z_OPEN ; base+#09 Open a ZX Printer channel OPEN_R JP R_OPEN ; base+#0C Open a RAMDisc channel OPEN_N JP MODIFY_N ; base+#0F Modify a Network channel DEMO_1 JP WIND_DEMO ; base+#12 Demo opening #4 to "W" DEMO_2 JP WIND_DEMO XCLOSE AND A ; Test bit 7 JP M,CLEAR_ALL ; A=#FF, flush and close all new channels ; CLOSE A CHANNEL ; --------------- ; Close a new channel. On entry the A register must contain the stream number ; to be closed. If entered at CLOSE_CLR then: ; Carry Clear= data in buffers ignored and lost ; Carry Set = data in buffers sent. CLOSE_NEW SCF ; Signal "Data in buffer to be sent" CLOSE_CLR PUSH AF ; Stack stream number EX AF,AF' ; F' stores the Carry flag POP AF ; A= stream number to close CALL STR_DATA_A ; BC= stream data for given stream or zero ; HL points to appropriate STRMS variable PUSH HL ; Stack pointer to STRMS variable LD HL,#FFEB ; HL= -15h ADD HL,BC POP HL ; HL points to STRMS variable RET NC ; Return with channels "K", "S", "R" ; and "P", and also with streams which ; are already closed LD IX,(CHANS) ; IX points to channel info area ADD IX,BC DEC IX ; IX points to channel information ; block for the given channel LD A,(IX+#05) ; Check channel identifier CP #34 RET NZ ; Not #xx34 LD A,(IX+#06) CP #12 RET NZ ; Not #12xx - return if this is not one of ; our new user-defined channels LD (HL),#00 INC HL LD (HL),#00 ; Reset the STRMS variable, thus ; closing the stream PUSH BC ; Stack displacement into channel ; information area LD L,(IX+#07) LD H,(IX+#08) ; HL= address of "Close" subroutine to ; send data in buffer EX AF,AF' ; Retrieve "Send data in buffer" flag CALL C,CALL_JUMP ; Send data if required PUSH IX POP HL ; HL points to channel info block LD C,(IX+#09) LD B,(IX+#0A) ; BC=length of channel info block PUSH BC CALL RECLAIM_2 ; Reclaim the memory used by block POP BC ; Now adjust stream pointers for channels that have moved LD A,#10 ; A=number of streams to consider LD HL,STRMS_00 ; HL points to stream zero variable CLOSELOOP LD E,(HL) INC HL LD D,(HL) ; DE=stream variable for next stream EX (SP),HL ; HL=stream variable for stream ; just closed AND A SBC HL,DE ADD HL,DE JR NC,CLOSENEXT ; Jump unless the channel information ; block for this stream has moved EX DE,HL AND A SBC HL,BC EX DE,HL ; DE=updated stream variable for ; this stream EX (SP),HL ; HL points to 2nd byte of STRMS var DEC HL ; HL points to 1st byte of STRMS var LD (HL),E INC HL LD (HL),D ; Store new value of streams variable EX (SP),HL CLOSENEXT EX (SP),HL ; HL points to 2nd byte of STRMS var INC HL ; HL points to next STRMS variable DEC A JR NZ,CLOSELOOP ; Loop back to consider remaining ; streams POP AF ; Balance the stack RET ; Return ; CLOSE ALL ; --------- ; Close all new channels. Any data held in buffers will be lost, and the ; memory used by all of the new user-defined channels will be reclaimed. CLEAR_ALL LD A,#10 ; A=number of streams to consider CLEARLOOP DEC A ; A=stream number of current stream PUSH AF AND A ; Signal "Data in buffers to be lost" CALL CLOSE_CLR ; Clear the channel associated with ; this stream POP AF JR NZ,CLEARLOOP ; Loop back until all streams cleared RET ; Return ; CREATE A NEW CHANNEL ; ----------------------------------- ; Equivalent of OPEN#s,"C",parameters ; ; On entry: ; A = stream number ; A' = name of the channel (an ASCII character code) ; BC = length of the required channel information block ; DE = input address ; HL = output address ; IX = close address, subroutine to send any data stored in buffers ; (or the RET at #0052 if this does not apply) ; OPEN_NEW1 EX AF,AF' ; Swap stream number into A' OPEN_NEW PUSH BC ; Stack length of channel info block PUSH IX ; Stack close buffer address PUSH AF ; Stack name of channel PUSH DE ; Stack input address PUSH HL ; Stack output address PUSH BC ; Stack length of info block (again) EX AF,AF' ; A= stream number to attach CALL STR_DATA_A ; BC=stream data for given stream EX (SP),HL ; Stack stream pointer, HL=saved BC PUSH HL ; Stack saved BC back again LD HL,#FFEB ADD HL,BC JR NC,OPEN_NEW2 ; Jump if closed or K/S/P/R channel RST #08 ; Stream is already open, give an error DEFB #17 ; "O Invalid stream" error report ; LD A,B ; OR C ; [This next command was missed out of the listing in part 2.] ; [A correction wasn't printed until part 5. JimG] ; POP BC ; JR Z,OPEN_NEW2 ; Jump if stream is closed ; RST #08 ; Stream is already open, give an error ; DEFB #17 ; "O Invalid stream" error report ;OPEN_NEW2 PUSH HL ; Stack pointer to stream variable OPEN_NEW2 POP BC ; Get channel length LD HL,(PROG) ; PROG is after end of CHANS area DEC HL ; HL points to #80 byte at end of ; channel information area CALL MAKE_ROOM ; Make room for new channel info INC HL ; HL points to new channel info block LD (CURCHL),HL ; Make this the current channel PUSH HL POP IX ; IX points to channel info block INC HL ; HL points to second byte of info LD BC,(CHANS) ; BC points to start of CHANS area AND A SBC HL,BC ; HL=required stream value EX DE,HL ; DE=required stream value POP HL ; HL points to stream variable LD (HL),E INC HL LD (HL),D ; Assign stream variable with required ; value, thus opening the stream PUSH IX POP HL ; HL points to channel info block POP DE ; DE=output address POP BC ; BC=input address CALL OPENSTORE ; Store these addresses in info block POP AF ; A=name of channel LD (HL),A ; Store name of channel INC HL LD (HL),#34 INC HL LD (HL),#12 ; Signal "User-defined channel" INC HL POP DE ; DE=close buffer address POP BC ; BC=length of channel info block OPENSTORE LD (HL),E INC HL LD (HL),D ; Store output or close address INC HL LD (HL),C INC HL LD (HL),B ; Store input address or block length INC HL RET ; Return ; To deal with parameters of control codes, and keyword tokens. This subroutine ; may be used with any user-defined channel where (IX+0B) contains flags. ; Bits 1 and 0 count incoming parameters for use with colour controls, AT and ; TAB, while bit 7 is set if a space has just been printed to the channel. ; On return: ; Sign flag will be set if no more needs to be done ; Sign flag will be clear if more needs be done, and: ; Zero flag will be set if the character is a graphics character ; Carry flag will be set for block graphics and control codes. CHR_TYPE LD C,A ; C=character to print LD A,(IX+#0B) ; A contains various flags LD D,A ; D contains various flags AND #03 ; A=number of parameters expected JR Z,CTYP_GO ; Jump if no parameters expected DEC D LD A,D LD (IX+#0B),A ; Decrement parameter count AND #03 JR Z,CTYP_LAST ; Jump if this is the last parameter LD (IY+TVDATAhi),C ; Store this (middle) parameter JR CTYP_DONE ; Jump to exit CTYP_LAST LD A,(TVDATA) ; A=original control code LD B,(IY+TVDATAhi) ; B=middle parameter (if one exists) JR CTYP_CTRX ; Jump to exit CTYP_GO LD HL,FLAGS ; HL points to system flags LD E,SPECTRUM ; E=the 1st Spectrum 128K keyword BIT 4,(HL) JR NZ,CTYP_MODE ; Jump if in 128K mode LD E,RND ; E= the 1st Spectrum 16K/48K keyword CTYP_MODE LD A,C ; A= character to print CP E JR C,CTYP_NTOK ; Jump unless this is a keyword LD A,(IX+#0B) ; A contains various flags RLCA ; Bit 0 = leading space bit XOR (HL) AND #01 XOR (HL) LD (HL),A ; Assign leading space bit as reqd LD A,C ; A=character to print CALL P_TUDG ; Expand this keyword JR CTYP_DONE ; Jump to exit CTYP_NTOK CP #80 JR C,CTYP_NGRA ; Jump unless this is a graphics char RES 7,(IX+#0B) ; Signal "Leading space will be reqd" CP #90 JR NC,CTYP_UDG ; Jump if this is a UDG CP A ; Set the Zero flag SCF ; Set the Carry flag RET ; Return CTYP_UDG CP A ; Set Zero flag, reset Carry flag RET ; Return CTYP_NGRA CP #20 JR C,CTYP_CTRL ; Jump with control characters RES 7,(IX+#0B) ; Signal "Leading space will be reqd" JR NZ,CTYP_SPCE ; Jump unless character is SPACE SET 7,(IX+#0B) ; Signal "Leading space not reqd" CTYP_SPCE AND A ; Reset Zero flag; reset Carry flag RET ; Return CTYP_CTRL CP #10 JR C,CTYP_CTRX ; Jump to exit with codes #00 to #0F CP #18 JR C,CTYP_PARA ; Jump with codes #10 to #18 CTYP_CTRX CP #FF ; Reset Zero flag; set Carry flag RET ; Return with #00-#0F or #18-#1F CTYP_PARA LD (TVDATA),A ; Store control code INC D ; Signal "One parameter required" CP #16 JR C,CTYP_SET ; Jump with codes #10 to #16 INC D ; Signal "Two parameters required" CTYP_SET LD (IX+#0B),D ; Store number of reqd parameters CTYP_DONE OR #FF ; Set the Sign flag RET ; Return ; Deal with the comma control and the TAB function as well. This subroutine ; may be used with any user-defined channel where: ; (IX+0B) contains flags as above ; (IX+0C) contains the x coordinate (or column number) of the current position ; (IX+0D) contains the width of the line (or total number of columns allowed). ; Flags on return are as above, except that the Sign flag will be set if comma ; or TAB have been dealt with. CHR_TYPE2 CALL CHR_TYPE ; Deal with control parameters and keywords CHRTYPE2A LD E,(IX+#0D) ; E=width of line PUSH AF ; Stack the flags CP #06 JR Z,CTYP_COMM ; Jump with comma control CP #17 JR Z,CTYP_TAB ; Jump with TAB control POP AF ; Restore the flags RET ; Return CTYP_COMM LD A,(IX+#0C) ; A=column number of print position INC A AND #F8 ADD A,#08 ; A=column number of next field CP E JR C,CTYP_SPCS ; Jump if column number is in range LD A,E JR CTYP_SPCS ; Else tab past end of current line CTYP_TAB LD H,C LD L,B ; HL=TAB parameter LD D,#00 ; DE=width of line CTYP_LOOP SBC HL,DE JR NC,CTYP_LOOP ADD HL,DE ; Reduce modulo line length LD A,L ; A=column number to TAB to AND A JR NZ,CTYP_SPCS ; Jump unless column zero is required LD A,E ; Tab past end of current line CTYP_SPCS CP (IX+#0C) JR Z,CTYP_EXIT ; Jump if required column reached PUSH AF CALL PO_SPACE ; Print a space POP AF JR CTYP_SPCS ; Jump back to see if finished CTYP_EXIT POP AF ; A=control just dealt with OR #FF ; Set the Sign flag RET ; Return ; The following two entry points PAGE_0 and PAGE_7 will page in RAM page zero ; and RAM page seven respectively. The routines will have no effect unless ; called from a Spectrum 128 in 128K mode. PAGE_0 PUSH BC LD B,#00 ; B=required page number JR PAGE_B ; Jump forward PAGE_7 PUSH BC LD B,#07 ; B=required page number PAGE_B PUSH AF BIT 4,(IY+FLAGS-#5C3A) JR Z,PAGE_EXIT ; Jump if not in 128K mode LD A,(BANK_M) ; A=current page flags AND #F8 OR B LD BC,#7FFD ; BC=port to change page LD (BANK_M),A ; Update currently selected RAM page OUT (C),A ; Actually change page PAGE_EXIT POP AF POP BC RET ; Return ; The following three subroutines require that initially HL points to a byte on ; the screen, and will each adjust the value of HL in a different way. The first ; will point HL to the pixel immediately below the given one, the second will ; point HL down one line (ie. down eight pixels), and the third will find the ; address of the corresponding attribute byte. DOWN_1 INC H ; Assume within a character square LD A,H AND #07 RET NZ ; Return if this is so LD A,L ADD A,#20 LD L,A ; Assume crossing screen thirds RET C ; Return if this is so LD A,H SUB #08 LD H,A ; Adjust for within screen third RET ; Return DOWN_8 LD A,L ADD A,#20 LD L,A ; Assume within screen third RET NC ; Return if this is so LD A,H ADD A,#08 LD H,A ; Adjust for crossing screen thirds RET ; Return ATTR_ADDR LD A,H RRA RRA AND #06 ; Isolate screen third number OR #B0 RL H ; Carry flag = screen number RRA LD H,A ; HL=attribute byte address RET ; Return ; The remainder of the program in this article is concerned exclusively with ; WINDOW channels. The following subroutine will move the print position to the ; start of the (A+1)th line of the current window. LINE_A CP (IX+W_HEIGHT) JP NC,REPORT_B ; Give error if line number too big LD (IX+W_XCOORD),#00 ; Reset x coordinate LD (IX+W_YCOORD),A ; Assign new y coordinate LD L,(IX+W_HOMElo) LD H,(IX+W_HOMEhi) ; HL=address of top LH corner AND A JR Z,LINEFOUND ; Jump if line zero required LD B,A ; B= line number required LINE_LOOP CALL DOWN_8 ; HL=address of next line DJNZ LINE_LOOP ; HL=address of required line LINEFOUND CALL STOREADDR ; Store this address as print position SET 7,(IX+W_FLAGS) ; Signal "Leading space not required" BIT 4,(IX+W_FLAGS) RET Z ; Return if this is a "Fast" channel LD (IX+W_PIX),#00 ; Reset print pos within char square RET ; Return ; The next subroutine will clear one line of a window, given that A contains ; the attribute byte with which to clear, that HL contains the address of the ; line within the screen; and that BC contains the width of the line in ; squares, less one. CLW_LINE PUSH BC ; Stack length of line, less one PUSH HL ; Stack address of line PUSH AF ; Stack attribute byte CALL ATTR_ADDR ; HL=address of attribute line POP AF ; A= attribute byte LD D,H LD E,L INC DE ; DE points to second attribute byte LD (HL),A ; Store first attribute byte LDIR ; Store remaining attribute bytes POP HL ; HL=address of line POP BC ; BC=length of line, less one LD A,#08 ; A= number of rows per line LD D,H LD E,L INC DE ; DE points to second byte in line CLWL_LOOP PUSH HL ; Stack address of 1st byte in row PUSH DE ; Stack address of 2nd byte in row PUSH BC ; Stack length of line, less one LD (HL),#00 ; Reset first byte LDIR ; Reset remaining bytes POP BC ; BC=length of line, less one POP DE ; DE=address of 2nd byte in row POP HL ; HL=address of 1st byte in row PUSH AF ; Stack loop counter CALL DOWN_1 ; HL=addr of 1st byte in next row POP AF ; A= loop counter INC D ; DE=address of 2nd byte in row DEC A JR NZ,CLWL_LOOP ; Repeat for all eight rows RET ; Return ; This very short subroutine will fetch the width of the current window, ; measured in character squares, into the C register. GET_WIDTH LD C,(IX+W_WIDTH) ; C=width of window, in characters BIT 4,(IX+W_FLAGS) RET Z ; Return with "Fast" windows LD C,(IX+W_WIDTH_8) ; C=width of window, in squares RET ; OPEN A WINDOW CHANNEL ; --------------------- ; Open a WINDOW channel and attach it to a stream. This subroutine will open ; either a "Fast" or a "Slow" window channel. The registers must be assigned on ; entry as follows: ; ; For both types of channel: ; A = Stream number to which the channel is to be attached ; A' = Attribute byte used initially by the window ; B = Number of lines between the top of the window and the top of the screen ; C = Number of character squares between the left of the window and the left ; of the screen ; D = Height of the window, in character squares ; E = Width of the window, in character squares ; H = #00 if scroll pause is disabled, #FF if scroll pause is enabled ; L = #00 for a "Fast" window, #FF for a "Slow" window ; ; For SLOW windows only: ; BC' = Address of normal character set, minus #100 ; DE' = Address of graphics character set (beginning at CHR$ #80) ; H' = The width of these characters, in pixels ; W_OPEN EX AF,AF' ; Swap stream into A' PUSH AF ; Stack attribute byte PUSH BC ; Stack coordinates of window PUSH DE ; Stack size of window PUSH HL ; Stack flags LD BC,#0016 ; BC=length of "Fast" channel info block LD IX,#0052 ; Signal "No buffer", presuming "Fast" channel INC L ; [The next line was printed as 2021 in the magazine,] ; [which jumped to the wrong address. JimG] JR NZ,OPWN_CREA ; Jump with "Fast" channels LD D,#00 ; DE=window width, in squares LD H,D LD L,E ; HL=window width, in squares ADD HL,HL ; Multiply by 8 ADD HL,HL ADD HL,HL ; HL=window width, in pixels EXX LD A,H ; A=character width in pixels EXX LD E,A ; E=character width in pixels LD A,#FF ; A=-1 OPWN_LOOP INC A SBC HL,DE JR NC,OPWN_LOOP ; A=width of window, in characters EXX LD L,A EXX ; L'=width of window, in characters LD E,A ; DE=width of window, in characters LD HL,#001E ; HL=length of "Slow" channel info ; block, excluding buffer ADD HL,DE ; HL=total length of chan info block LD B,H LD C,L ; BC=total length of chan info block LD IX,EMPTY_2 ; IX points to empty buffer subroutine OPWN_CREA LD HL,WINDOW ; HL points to output subroutine LD DE,REPORT_J ; DE points to input error routine LD A,"W" ; A=name of this channel CALL OPEN_NEW ; Open the channel POP HL ; HL=flags POP DE ; DE=size of window POP BC ; BC=coordinates of window POP AF ; A= attribute byte for window LD (IX+W_ATTR),A ; Store attribute byte XOR A ; A=00 RR L RRA ; [The next line was printed as CB17 RR H in the magazine,] ; [but CB17 is RL A, and CB1C is RR H. As this is setting ] ; [the "Scroll pause" and "Fast/Slow" flags in bits 5 & 4 ] ; [of W_FLAGS, CB1C RR H must be correct. JimG ] RR H RRA RRA RRA ; Construct flags byte LD (IX+W_FLAGS),A ; Store these flags LD (IX+W_WIDTH),E ; Store window width LD (IX+W_HEIGHT),D ; Store window height LD A,B ; A=y coordinate of window AND #98 OR #40 LD (IX+W_HOMEhi),A ; Store high part of address of top ; left-hand corner of window LD A,B ; A=y coordinate of window RRCA RRCA RRCA ; [There was a chunk of the ENTER subroutine at B2BB from the next issue] ; [printed in the magazine at this point - which I've omitted. JimG] ; [The next line was printed as E6B0 AND E0 in the magazine,] ; [but E6B0 is AND B0, and E6E0 is AND E0. The latter command] ; [gives the correct result. JimG] AND #E0 OR C LD (IX+W_HOMElo),A ; Store low part of address of top ; left-hand corner of window BIT 4,(IX+W_FLAGS) JR Z,CLSWINDOW ; Jump with "Fast" window LD (IX+W_WIDTH_8),E ; Store window width, in squares EXX LD (IX+W_WIDTH),L ; Store window width, in characters LD (IX+W_CH_WID),H ; Store character width, in pixels LD (IX+W_CHARSlo),E LD (IX+W_CHARShi),D ; Store addr of character set -100h LD (IX+W_UDGlo),C LD (IX+W_UDGhi),B ; Store addr of graphics char set ; Control does not return immediately from the above routine, but continues ; into the next subroutine, whose purpose it is to clear a window and move the ; print position to the top left-hand corner. It is the WINDOW equivalent to ; CLS. CLSWINDOW XOR A ; A=00 CALL LINE_A ; Move print pos to top left corner CALL GET_WIDTH ; C=width of window, in squares JR Z,CLSW_CONT ; Jump with "Fast" windows LD (IX+W_LEN),#00 ; Clear buffer, abandoning contents CLSW_CONT LD B,(IX+W_HEIGHT) ; B=height of window, in squares LD A,(IX+W_ATTR) ; A=attribute byte LD (IX+W_SCROLLS),#01 ; Reset scroll count CALL PAGE_7 ; Use RAM page 7 in case screen 1 in use DEC C ; C=width of window, minus one CLSW_LOOP PUSH BC LD B,#00 ; BC=width of window, minus one PUSH AF CALL CLW_LINE ; Clear next line of window POP AF POP BC DJNZ CLSW_LOOP ; Clear whole window JP PAGE_0 ; The following subroutine prints a newline, ie. it moves the print position to ; the left-hand edge of the next line down. ENTER CALL ENTER_1 ; Print a single newline once BIT 2,(IX+W_FLAGS) RET Z ; Return if using single height ENTER_1 LD A,(IX+W_YCOORD) ; A=current y coordinate INC A ; A=new y coordinate CP (IX+W_HEIGHT) JP NZ,LINE_A ; Jump if in range to move print pos BIT 5,(IX+W_FLAGS) JR Z,SCROLL ; Jump if scroll pause disabled DEC (IX+W_SCROLLS) ; Decrement scroll count JR NZ,SCROLL ; Jump unless scroll pause required LD A,(IX+W_HEIGHT) LD (IX+W_SCROLLS),A ; Re-initialise scroll count SCR_PAUSE LD A,#7F IN A,(#FE) ; Scan part of the keyboard RRA JR C,SCR_PAUSE ; Pause until SPACE pressed SCROLL CALL BREAK_KEY ; Check if BREAK (SHIFT-SPACE) is pressed JP NC,REPORT_D ; Give error report if BREAK pressed LD A,(IX+W_YCOORD) ; A=y coordinate of bottom line PUSH AF CALL LINE_A ; Move print pos to start of bottom ; line of window POP BC ; B=number of lines to copy CALL GET_WIDTH ; C=width of window in squares LD L,(IX+W_HOMElo) LD H,(IX+W_HOMEhi) ; HL=address of top left corner CALL PAGE_7 ; Use RAM page 7 in case screen 1 used SCR_LOOP1 PUSH BC ; Stack loop counter LD B,#00 ; BC= width of line PUSH BC PUSH HL CALL ATTR_ADDR ; HL=address of this attribute line LD DE,#0020 EX DE,HL ; DE=address of this attribute line ADD HL,DE ; HL=address of next attribute line LDIR ; Copy one attribute line POP HL POP BC PUSH HL CALL DOWN_8 ; HL=address of next line POP DE ; DE=address of this line PUSH HL LD A,#08 ; A=number of rows per line SCR_LOOP2 PUSH BC PUSH DE PUSH HL LDIR ; Copy one row from line POP HL POP DE POP BC INC H ; HL=address of next row of next line INC D ; DE=address of next row of this line DEC A JR NZ,SCR_LOOP2 ; Copy whole line POP HL POP BC DJNZ SCR_LOOP1 ; Transfer all required lines DEC BC ; BC=length of line, less one LD A,(IX+W_ATTR) ; A= attribute byte CALL CLW_LINE ; Clear bottom line JP PAGE_0 ; Restore RAM page zero and return ; The following subroutine deals with all control codes except for comma-control ; and TAB (these are dealt with by CHR_TYPE2). On entry the A register will ; contain the control code itself, while any parameters required will be stored ; in B (middle parameter, if one exists) and C (last parameter). CONTROLS CP 13 JR Z,ENTER ; Jump to deal with "enter" SUB #10 RET C ; Return with codes 00 to 0F CP #06 JR Z,CTRL_AT ; Jump to deal with AT RET NC ; Return with codes 17 to 1F ADD A,CTRL_INFOlo LD L,A LD H,CTRL_INFOhi ; HL points to control info table LD B,(HL) ; B= bit mask for this control LD DE,W_ATTR ; DE=IX displacement to W_ATTR CP #63 JR C,CTRL_CONT ; Jump unless ctrl is INVERSE/OVER LD E,W_FLAGS ; DE=IX displacement to W_FLAGS CTRL_CONT PUSH IX POP HL ; HL points to channel info block ADD HL,DE ; HL points to variable to alter LD A,C ; A=control parameter LD C,B ; C=bit mask RRCA CTRL_LOOP RLCA RR B JR NC,CTRL_LOOP ; A=ctrl parameter in correct position XOR (HL) AND C XOR (HL) ; Mix in reqd bits according to mask LD (HL),A ; Store variable RET CTRL_INFO DEFB #07 ; Bit mask for INK DEFB #38 ; Bit mask for PAPER DEFB #80 ; Bit mask for FLASH DEFB #40 ; Bit mask for BRIGHT DEFB #08 ; Bit mask for INVERSE DEFB #04 ; Bit mask for OVER CTRL_INFOlo EQU CTRL_INFO & 255 CTRL_INFOhi EQU CTRL_INFO / 256 ; The next subroutine is the WINDOW version of the AT function. It performs the ; function AT B,C for the current window. CTRL_AT PUSH BC LD A,B ; A=proposed y coordinate CALL LINE_A ; Move print pos to start of this line POP BC LD A,C ; A=proposed x coordinate AND A RET Z ; Return if task already done CP (IX+W_WIDTH) JP NC,REPORT_B ; Give error report if out of range LD (IX+W_XCOORD),A ; Store new x coordinate LD B,#00 ; BC=x coordinate BIT 4,(IX+W_FLAGS) JR Z,AT_EXIT ; Jump with "Fast" channels PUSH HL ; Stack address of start of line LD C,(IX+W_CH_WID) ; BC=character width in pixels LD H,B LD L,B ; HL=0000 AT_LOOP_1 ADD HL,BC DEC A JR NZ,AT_LOOP_1 ; HL=number of pixels to start of char LD B,#03 AT_LOOP_2 SRL H RR L RRA DJNZ AT_LOOP_2 ; HL=number of squares to start of char RLCA RLCA RLCA ; A=pixel position within char square LD (IX+W_PIX),A ; Store in variable POP BC ; BC=address of start of line AT_EXIT ADD HL,BC ; HL=new print position address STOREADDR LD (IX+W_PRPOSlo),L LD (IX+W_PRPOShi),H ; Store new print position RET ; Return ; The following subroutine is very short and simple. It merely sets the ; attribute byte corresponding to the screen address in HL. SET_ATTR PUSH HL CALL ATTR_ADDR ; HL=address of attribute byte LD A,(IX+W_ATTR) ; A= current colours LD (HL),A ; Store attribute byte POP HL RET ; Return ; This subroutine is intended for use with "Slow" windows only. It will plot ; one row of a character onto the screen. PLOT_ROW CALL SET_ATTR ; Set attribute byte LD A,(HL) ; A=byte from screen XOR D AND B XOR D ; Mix in bits from character LD (HL),A ; Store in screen LD A,C ; A=low byte of mask INC A JR Z,PLRW_EXIT ; Exit if all bits stored on screen INC HL ; HL points to next screen byte CALL SET_ATTR ; Set this attribute byte as well LD A,(HL) ; A=byte from screen XOR E AND C XOR E ; Mix in bits from character LD (HL),A ; Store in screen DEC HL ; HL points to original screen byte PLRW_EXIT JP DOWN_1 ; Point HL one pixel down, and return ; This subroutine will calculate 8*A+DE, and will also collect the current ; print position. PREPARE LD L,A LD H,#00 ; HL=character code ADD HL,HL ; Multiply HL by 8 ADD HL,HL ADD HL,HL ADD HL,DE ; Add to start of chars, HL=address of this character EX DE,HL ; DE=address of this character LD L,(IX+W_PRPOSlo) LD H,(IX+W_PRPOShi) ; HL=address of print position RET ; Return ; This subroutine will collect one byte from the pixel matrix pointed to by DE ; and will invert it if necessary. GET_ROW LD A,(DE) ; A= next row of pixel expansion INC DE ; DE points to next row BIT 3,(IX+W_FLAGS) RET Z ; Return unless INVERSE 1 in operation CPL ; Otherwise invert the row RET ; This next and very important subroutine will actually print a character, ; specified in the A register, onto the current window. PRINT_CHR PUSH AF ; Stack character to print PUSH AF ; Stack character to print (again) LD A,(IX+W_XCOORD) ; A=current X coordinate CP (IX+W_WIDTH) CALL Z,ENTER ; Print newline if at end of line BIT 4,(IX+W_FLAGS) JR NZ,PCHRSLOW ; Jump with "Slow" window POP AF ; A= character to print LD DE,(CHARS) ; DE=address of normal char set minus #100 JR NZ,PCHR_OK_1 ; Jump with ASCII character JR NC,PCHR_UDG ; Jump with user-defined graphics LD B,A CALL PO_GR_1 ; Construct block graphic LD DE,MEMBOT ; DE points to pixel matrix XOR A JR PCHR_OK_1 ; Jump forward PCHR_UDG SUB #90 LD DE,(UDG) ; DE points to user-defined graphics PCHR_OK_1 CALL PREPARE ; DE=address of character matrix ; HL=address of print position CALL SET_ATTR ; Set attribute for this square PUSH HL LD B,#08 ; B= number of rows per line PCHRLOOP1 CALL GET_ROW ; A= next row from expansion CALL PAGE_7 ; Use RAM page 7 in case screen 1 in use LD (HL),A ; Store row in screen INC H ; HL points to next row CALL PAGE_0 ; Restore RAM page zero DJNZ PCHRLOOP1 ; Print whole character POP HL INC HL ; HL=new print position JP PCHR_EXIT ; Jump to exit PCHRSLOW BIT 2,(IX+W_FLAGS) JR Z,PCHRSLOW2 ; Jump unless using double height LD A,(IX+W_HEIGHT) ; A=height of window DEC A ; A=y coordinate of bottom line CP (IX+W_YCOORD) JR NZ,PCHRSLOW2 ; Jump unless at bottom line LD C,(IX+W_XCOORD) ; C=current x coordinate LD B,A ; B=current y coordinate DEC B ; B=y coordinate after scroll LD A,(IX+W_FLAGS) PUSH AF ; Stack flags PUSH BC ; Stack coordinates CALL ENTER_1 ; Scroll the screen once POP BC ; BC=coordinates CALL CTRL_AT ; Move print position back where it ; belongs POP AF LD (IX+W_FLAGS),A ; Restore the flags PCHRSLOW2 POP AF ; A=character to print LD E,(IX+W_CHARSlo) LD D,(IX+W_CHARShi) ; DE=address of normal char set minus #100 JR NZ,PCHR_OK_2 ; Jump with ASCII characters SUB #80 LD E,(IX+W_UDGlo) LD D,(IX+W_UDGhi) ; DE points to graphics chr set PCHR_OK_2 CALL PREPARE ; DE=address of character matrix ; HL= address of print position PUSH HL ; Stack address of print position LD BC,#FFFF LD A,(IX+W_CH_WID) ; A=width of char in pixels PCHRMASK1 SRL B RR C DEC A JR NZ,PCHRMASK1 ; BC=mask, not yet in position LD A,(IX+W_PIX) ; A= pixel posn within char square AND A JR Z,PCHRMASK3 ; Jump if mask OK PCHRMASK2 SCF RR B RR C DEC A JR NZ,PCHRMASK2 ; Otherwise rotate mask into place PCHRMASK3 LD A,#08 ; A=number of rows per line PCHRLOOP2 PUSH AF ; Stack loop counter CALL GET_ROW ; A=next row from expansion PUSH DE ; Stack pointer into expansion LD D,A LD A,(IX+W_PIX) ; A=pixel posn within chr square AND A JR Z,PCHR_ROW ; Jump if pixels correctly aligned PCHRSHIFT RR D RR E DEC A JR NZ,PCHRSHIFT ; Shift pixels into position PCHR_ROW CALL PAGE_7 ; Set RAM page 7 in case screen 1 in use CALL PLOT_ROW ; Plot row onto screen BIT 2,(IX+W_FLAGS) CALL NZ,PLOT_ROW ; And again if using double height CALL PAGE_0 ; Restore RAM page zero POP DE ; DE points to pixel expansion POP AF ; A= loop counter DEC A JR NZ,PCHRLOOP2 ; Print whole character POP HL ; HL= original print position LD A,(IX+W_PIX) ; A= original position within square ADD A,(IX+W_CH_WID) ; Allow for width of character PCHR_POS CP #08 JR C,PCHR_POS2 ; Jump if print position OK SUB #08 INC HL ; Otherwise amend it JR PCHR_POS ; Loop back to try again PCHR_POS2 LD (IX+W_PIX),A ; Store new position within square PCHR_EXIT CALL STOREADDR ; Store new print position INC (IX+W_XCOORD) ; Increment x coordinate POP AF ; A=character just printed RET ; Return ; The following subroutine will empty the buffer ("Slow" windows only), ; printing the stored contents into the window. EMPTY CALL NC,ENTER ; Print a newline if required PUSH IX POP HL ; HL points to channel info block LD BC,W_LEN ADD HL,BC ; HL points to variable W_LEN LD A,(HL) ; A=number of characters in buffer AND A EMPTYLOOP RET Z ; Return if finished INC HL ; HL points to next char in buffer LD A,(HL) PUSH HL CALL CTYP_NTOK ; Flags indicate type of character CALL PRINT_CHR ; Print the character POP HL DEC (IX+W_LEN) JR EMPTYLOOP ; The following subroutine will empty the buffer ("Slow") or do nothing ; ("Fast"). It will decide whether or not a newline is required, and print one ; if so. EMPTY_2 BIT 4,(IX+W_FLAGS) RET Z ; Return with "Fast" windows LD D,A ; D=next character to print LD A,(IX+W_LEN) ; A=length of word in buffer ADD A,(IX+W_XCOORD) ; A=potential x coordinate after ; the buffer has been emptied CP (IX+W_WIDTH) JR NZ,EMPTY_OUT ; Jump unless word exactly fills line LD D,E ; D=alternative char to print SCF ; Signal "Newline not needed" EMPTY_OUT PUSH DE PUSH BC CALL EMPTY ; Empty buffer with newline if needed POP BC POP AF ; A=next character to print RET ; Return ; And now at last we have the window output subroutine itself. WINDOW LD IX,(CURCHL) ; IX points to channel info block CALL CHR_TYPE ; Deal with keywords, etc. RET M ; Return if tasks completed PUSH AF ; Stack character to print JR Z,WIND_ABLE ; Jump with graphics characters JR NC,WINDASCII ; Jump with ASCII characters ; AND A CP #0C CALL Z,CLSWINDOW ; Clear window for CHR$12 POP AF PUSH AF LD E,A ; Signal "Char not to be changed" CALL EMPTY_2 ; Empty buffer CALL CHRTYPE2A ; Deal with TAB and comma control WIND_CTRL CALL CONTROLS ; Deal with remaining ctrl characters POP AF AND A ; Reset Carry flag RET ; Return WINDASCII CP 32 ; Space JR NZ,WIND_ABLE ; Jump with all chars except "space" LD E,13 ; Use "enter" as alternative char CALL EMPTY_2 ; Empty buffer CP 13 JR Z,WIND_CTRL ; Jump if newline now required JR WINDPRINT ; Jump to print "space" on window WIND_ABLE BIT 4,(IX+W_FLAGS) JR NZ,WIND_SLOW ; Jump with "Slow" windows WINDPRINT POP AF JP PRINT_CHR ; Jump to print the character WIND_SLOW LD HL,(CURCHL) ; HL points to channel info block LD BC,W_LEN ADD HL,BC ; HL points to variable W_LEN LD A,(HL) ; A=number of chars in buffer CP (IX+W_WIDTH) JR NZ,WINDSLOW2 ; Jump unless buffer full PUSH HL CALL EMPTY ; Empty buffer POP HL WINDSLOW2 POP AF INC (HL) ; Increment offset into buffer LD C,(HL) LD B,#00 ; BC=new offset into buffer ADD HL,BC LD (HL),A ; Store char in buffer RET ; Return ; ZX PRINTER CHANNEL ; ------------------ Z_FLUSH LD A,(IX+Z_XCOORD) ; A=x coordinate within buffer AND A RET Z ; Return immediately if buffer empty Z_NEWLINE PUSH IX POP HL ; HL=address of channel info LD BC,Z_BUFFER ADD HL,BC ; HL points to new printer buffer DI ; Disable interrupts LD B,#08 Z_NL_LOOP PUSH BC CALL ZCOPYLINE ; Output next row to ZX Printer POP BC DJNZ Z_NL_LOOP ; Output all eight rows LD A,#04 OUT (#FB),A ; Switch off printer motor EI ; Enable interrupts Z_EMPTY PUSH IX POP HL ; HL=address of channel info LD BC,Z_BUFFER ADD HL,BC ; HL points to new printer buffer XOR A ; A=00 ZEMPTLOOP LD (HL),A ; Zero next byte of buffer INC HL ; HL points to next byte in buffer DJNZ ZEMPTLOOP ; Zero entire buffer SET 7,(IX+Z_FLAGS) ; Signal "Leading space not required" LD (IX+Z_XCOORD),A ; Reset x coordinate in buffer RET ; Return ZCOPYLINE LD A,B ; A=row number to output CP #03 SBC A,A ; A=FF (last 2 rows); 00 (otherwise) AND #02 ; A=02 (last 2 rows); 00 (otherwise) OUT (#FB),A ; Switch on printer motor, but with ; slow speed for last two rows LD D,A ; D="last 2 rows" flag Z_CL_LOOP CALL BREAK_KEY ; Test BREAK key JR C,Z_CL_NEXT ; Jump forward unless BREAK pressed LD A,#04 OUT (#FB),A ; Switch off printer motor EI ; Enable interrupts CALL Z_EMPTY ; Empty the new printer buffer RST #08 ; Report "D, BREAK - CONT repeats" DEFB #0C Z_CL_NEXT IN A,(#FE) ; A=status of printer ADD A,A RET M ; Return if printer not connected JR NC,Z_CL_LOOP ; Wait until printer stylus is ready JP COPY_L_2A ; Jump to print next row from buffer ; ZX PRINTER OUTPUT ; ----------------- Z_PRINT LD IX,(CURCHL) ; IX points to channel info area CALL CHR_TYPE2 ; Deal with keywords, control params, ; TAB and comma control RET M ; Return if tasks complete PUSH AF JR Z,ZGRAPHICS ; Jump with graphics characters JR NC,Z_ASCII ; Jump with ASCII characters CP #0D JR NZ,Z_PRCTRLS ; Jump unless char is "enter" CALL Z_NEWLINE ; Print a newline JR Z_EXIT ; and jump to exit Z_PRCTRLS SUB #14 JR C,Z_EXIT ; Jump with controls 00 to 13 LD B,#08 ; B has bit 3 set JR Z,Z_INVOVER ; Jump with "INVERSE control" DEC A LD B,#04 ; B has bit 2 set JR NZ,Z_AT ; Jump unless char is "OVER control" Z_INVOVER RR C SBC A,A ; A=00 (INVERSE 0 or OVER 0) ; or FF (INVERSE 1 or OVER 1) XOR (IX+Z_FLAGS) ; A=flags byte, but complemented if ; parameter is one AND B ; A all bits reset, except that bit ; 3 (INVERSE) or bit 2 (OVER) will be ; taken from flags byte, and ; complemented if parameter is one XOR (IX+Z_FLAGS) LD (IX+Z_FLAGS),A ; Bit 3 (INVERSE) or bit 2 (OVER) of ; flags byte will be assigned with ; parameter JR Z_EXIT ; Jump to exit Z_AT DEC A JR NZ,Z_EXIT ; Jump unless control is "AT control" LD A,C ; A required x coordinate CP #20 JP NC,REPORT_B ; Error if out of range LD (IX+Z_XCOORD),A ; Assign x coordinate as required JR Z_EXIT ; Jump to exit Z_ASCII LD DE,(CHARS) ; DE=address of character set minus #100 JR Z_CHR_1 ; Jump forward ZGRAPHICS SUB #90 JR NC,Z_UDG ; Jump with user-defined graphics LD B,A CALL PO_GR_1 ; Construct graphic in MEMBOT area LD HL,MEMBOT ; HL points to character matrix JR Z_CHR_2 ; Jump forward Z_UDG LD DE,(UDG) ; DE=address of user-defined graphics Z_CHR_1 LD L,A LD H,#00 ADD HL,HL ; Multiply by eight ADD HL,HL ADD HL,HL ADD HL,DE ; HL points to required character matrix Z_CHR_2 LD A,(IX+Z_XCOORD) ; A=current x coordinate in buffer CP #20 PUSH HL CALL Z,Z_NEWLINE ; Print a newline if buffer full POP DE ; DE points to graphic form LD A,(IX+Z_XCOORD) ; A=current x coordinate in buffer INC A ; A=new x coordinate LD (IX+Z_XCOORD),A ; Store in system variable ADD A,Z_BUFFER-1 LD C,A LD B,#00 ; BC=displacement to posn in buffer PUSH IX POP HL ; HL points to channel information ADD HL,BC ; HL points to current posn in buffer LD B,#08 Z_CHRLOOP EX DE,HL ; DE=current buffer position ; HL points to graphic form LD A,(DE) ; A=byte from buffer BIT 2,(IX+Z_FLAGS) JR NZ,Z_CHROVER ; Jump if OVER off XOR A Z_CHROVER BIT 3,(IX+Z_FLAGS) JR Z,Z_CHR_INV ; Jump if INVERSE on CPL Z_CHR_INV XOR (HL) ; A=byte from graphic form, with ; OVER and INVERSE taken into account LD (DE),A ; Store in buffer PUSH HL ; Stack pointer into graphic form LD HL,#0020 ADD HL,DE ; HL points to appropriate byte in ; buffer for next row of character POP DE ; DE points into graphic form INC DE ; DE points to next byte to use DJNZ Z_CHRLOOP ; Print whole character into buffer Z_EXIT POP AF ; A= character just printed AND A ; Reset the Carry flag RET ; Return ; OPEN ZX PRINTER CHANNEL ; ----------------------- ; Open a ZX PRINTER channel and attach it to a stream. On entry the registers ; must be as follows: ; ; A = The stream number to which the channel is to be attached ; Z_OPEN EX AF,AF' ; A'=stream number to attach channel LD A,"Z" CALL SEARCHALL ; Search for another "Z" channel JP NC,REPORT_J ; Error if one exists LD IX,Z_FLUSH ; IX=close buffer address LD HL,Z_PRINT ; HL=output address LD DE,REPORT_J ; DE=input address LD BC,Z_BUFFER+#100 ; BC=length of channel info CALL OPEN_NEW ; Create the channel LD (IX+Z_FLAGS),#00 ; Reset the flags LD (IX+Z_WIDTH),#20 ; Specify buffer width = #20 chars JP Z_EMPTY ; Empty the buffer, and return ; Search for a stream already opened to the channel in A. SEARCHALL LD IX,(CHANS) ; IX points to base of channel info area LD BC,#0014 ; BC=offset to start of long channel blocks ; Skips default short blocks for K S R P LD D,A ; D=name of channel to search for SCHCHLOOP ADD IX,BC ; IX points to next channel info area SEARCH_CH LD A,(IX+#00) CP #80 ; Check for end of channel area SCF RET Z ; Return with Carry set if channel not found LD A,(IX+#04) ; A=name of channel pointed to CP D ; Compare with channel looking for RET Z ; Return with IX pointing to channel ; information area, and Carry reset, ; if search successful SEARCHNXT LD C,(IX+#09) LD B,(IX+#0A) ; BC=length of channel info JR SCHCHLOOP ; Loop back to continue search ; Call an address with Interface 1 paged in. SHADOW_DE LD HL,UNPAGE PUSH HL ; Stack UNPAGE address in Shadow ROM PUSH DE ; Stack Shadow subroutine address LD H,L ; HL=0000 PUSH HL ; Stack 0000 signalling "Return to ; Shadow ROM address" JP #0008 ; Jump to call Shadow subroutine ; "N" CHANNEL MODIFIED FOR QL ; --------------------------- Q_PRINT LD IX,(CURCHL) ; IX points to channel information PUSH AF ; Stack character to print CP 13 JR NZ,Q_PRINT_2 ; Jump unless character is "enter" LD A,#0A ; A=QL's code for "enter" Q_PRINT_2 LD E,(IX+#05) LD D,(IX+#06) ; DE=Shadow output address CALL SHADOW_DE ; Call network output in Shadow ROM POP AF ; A=character just printed AND A ; Reset the Carry flag RET ; Return Q_INPUT LD IX,(CURCHL) ; IX points to channel information LD HL,(ERR_SP) ; HL points to error return address LD E,(HL) INC HL LD D,(HL) ; DE=error return address LD HL,ED_ERROR AND A SBC HL,DE JR Z,Q_INPUT_2 ; Jump if in an INPUT channel Q_INKEY LD E,(IX+#07) LD D,(IX+#08) ; DE=Shadow input address CALL SHADOW_DE ; Call network input from Shadow ROM LD B,A ; B=character just input PUSH AF ; Stack the flags CP #0A JR NZ,Q_INKEY2 ; Jump unless this is a QL "enter" LD B,#0D ; B=Spectrum "enter" character Q_INKEY2 POP AF ; Restore the flags LD A,B ; A=character to return RET ; Return Q_INPUT_2 LD SP,(ERR_SP) ; Empty the machine stack down as ; far as ED_ERROR POP HL ; Drop the address ED_ERROR POP HL ; HL=normal error return address ptr LD (ERR_SP),HL ; Restore pointer to error return addr Q_INPLOOP CALL Q_INKEY ; Read next character from network JR C,QINPSTORE ; Jump if character OK JR Z,Q_INPLOOP ; Jump if still waiting RST #08 ; Error "8, End of file" DEFB #07 QINPSTORE CP #0D RET Z ; Return (INPUT is now finished) if ; character is "enter" CALL ADD_CHAR_1 ; Store the char in the INPUT line BIT 7,(IY+FLAGX) JR NZ,Q_INPLOOP ; Loop back if doing INPUT LINE CP #22 CALL Z,ADD_CHAR_1 ; Double-up quote characters JR Q_INPLOOP ; Go back for rest of INPUT ; MODIFY CHANNEL "N" FOR QL ; ------------------------- ; Modify an existing open "N" channel to convert characters to communicate ; with a QL. On entry the registers must be as follows: ; ; A = The stream number already opened to "N" ; MODIFY_N CALL STR_DATA_A ; BC=STRMS data for stream supplied LD A,B OR C JR Z,MOD_ERROR ; Error if stream not in use LD HL,(CHANS) ; HL points to base of chan info area ADD HL,BC ; HL points to 2nd byte of chan info INC HL INC HL INC HL ; HL points to 5th byte of channel info LD A,(HL) ; A=name of channel CP "N" JR Z,MOD_QL ; Jump only if channel is "N" MOD_ERROR RST #08 ; Report "O, Invalid stream" DEFB #17 MOD_QL DEC HL LD (HL),Q_INPUT / 256 DEC HL LD (HL),Q_INPUT & 255 ; Store new input address DEC HL LD (HL),Q_PRINT / 256 DEC HL LD (HL),Q_PRINT & 255 ; Store new output address RET ; Vector to Spectrum 128 routines V_ERROR JP #05AC ; Generate an error report V_PAGE JP #1C64 ; Change current RAM page V_NEWCAT JP #1C97 ; Create new entry in catalogue V_SPACE JP #1CF3 ; Ensure enough space in RAMdisc area V_FIND JP #1D12 ; Find catalogue entry for filename V_CATEND JP #1D56 ; Tidy up last catalogue entry ; Vector to Spectrum 128+2 routines ;V_ERROR JP #05CB ; Generate an error report ;V_PAGE JP #1C83 ; Change current RAM page ;V_NEWCAT JP #1CB6 ; Create new entry in catalogue ;V_SPACE JP #1D12 ; Ensure enough space in RAMdisc area ;V_FIND JP #1D31 ; Find catalogue entry for filename ;V_CATEND JP #1D75 ; Tidy up last catalogue entry ; The rest of the program will be the same, whichever version of the ; Spectrum 128 you have. The following subroutine will decrement a page-coded ; address held in register triplet BHL. DEC_BHL DEC HL ; Decrement HL LD A,B ; A=page code CP #05 RET Z ; Return if using standard RAM BIT 6,H RET NZ ; Return unless HL has crossed a page boundary SET 6,H ; Correct address in HL DEC B ; Decrement page code RET ; Return ; The following subroutine works a bit like a glorified LDDR instruction, which ; works in RAMdisc area as well as in standard memory. Its action is threefold: ; (1) Decrement BHL and BHL', (2) Load one byte from address (BHL) to address ; (BHL'), (3) If BHL is not equal to CDE then go to step (1). RTRANSFER CALL DEC_BHL ; Decrement page-coded address in BHL EXX CALL DEC_BHL ; Decrement page-coded address in BHL' EXX LD A,B ; A=paging code of FROM address CALL V_PAGE ; Page in the FROM memory page LD A,(HL) ; A=byte to load PUSH AF ; Stack this byte EXX LD A,B ; A=paging code of TO address CALL V_PAGE ; Page in the TO memory page POP AF ; A=byte to load LD (HL),A ; Load byte into memory as required EXX RTRANSFE2 LD A,B ; A=paging code of FROM address CP C JR NZ,RTRANSFER ; Loop back if not equal to the paging ; code of the limiting address SBC HL,DE ; Set Zero flag if address = limit ADD HL,DE ; (ADD HL,DE doesn't affect Zero flag) JR NZ,RTRANSFER ; Loop back unless limit has been ; reached RET ; Return ; The next subroutine will calculate the page-coded address which is BC bytes ; further on from AHL. It assumes that BC is always less than #4000. ADD_HL_BC ADD HL,BC ; Increment HL by BC bytes CP #05 RET Z ; Return if using standard RAM BIT 6,H RET NZ ; Return unless page boundary crossed SET 7,H SET 6,H ; Correct address in HL INC A ; Increment page code RET ; Return ; This subroutine will search for the file whose name is specified in the ; channel information area, in the RAMdisc catalogue, giving an error if the ; file does not exist. On exit IX will point to the catalogue entry. FIND_FILE PUSH IX POP HL ; HL points to channel information LD BC,#000E ADD HL,BC ; HL points to filename LD C,#0A ; BC=length of filename (ten) LD DE,N_STR1 ; DE points to system variable LDIR ; Copy filename into system variable CALL V_FIND ; Find catalogue entry for this name RET NZ ; Return if file exists, with IX ; pointing to catalogue entry CALL V_ERROR ; Generate error message DEFB #23 ; "h File does not exist" ; The next subroutine is designed to match up the buffer for R-channel with the ; corresponding region of RAMdisc memory. The subroutine will leave BHL pointing ; to the first byte beyond the RAMdisc segment, CDE pointing to the start of the ; RAMdisc segment, and BHL' pointing to the first byte beyond the corresponding ; region in the R-channel buffer. It will also signal whether or not this is an ; end-of-file block. It requires that IX initially points to the channel ; information block. R_MATCH PUSH IX ; Stack channel info address LD A,(IX+R_CHREC) PUSH AF ; Stack record number to match CALL FIND_FILE ; IX points to catalogue entry POP BC ; B= record number SLA B ; B= record number x 2 LD C,#01 ; BC=#200 * record number + 1 SCF EX AF,AF' ; Signal "End of file block" LD L,(IX+SF_LEN+0) LD H,(IX+SF_LEN+1) LD A,(IX+SF_LEN+2) ; AHL= length of file (17 bit) AND A SBC HL,BC SBC A,#00 ; AHL=length of remainder of file AND A JR NZ,RM_NO_EOF ; Jump if high part of AHL is non-zero LD DE,#0201 SBC HL,DE ADD HL,DE JR C,RM_EOF ; Jump if AHL less than 0201h RM_NO_EOF LD HL,#0200 ; HL= length of record (0200h max) EX AF,AF' ; Signal "Not end of file block" RM_EOF EX DE,HL ; DE= length of record LD L,(IX+SF_START+0) LD H,(IX+SF_START+1) LD A,(IX+SF_START+2) ; AHL=coded addr of start of file CALL ADD_HL_BC ; AHL= coded addr of RAMdisc segment PUSH BC ; Stack 200h * record number + 1 PUSH DE ; Stack length of record PUSH HL PUSH AF ; Stack page-coded address of segment LD B,D LD C,E ; BC= length of record CALL ADD_HL_BC ; AHL=page-coded address of byte ; following RAMdisc segment LD B,A ; BHL=this address POP AF LD C,A POP DE ; CDE=page-coded address of segment EXX ; Use alternative registers POP DE ; DE'=length of record POP BC ; BC'=200h * record number + 1 POP IX ; IX points to channel info area LD (IX+R_RECLEN+0),E LD (IX+R_RECLEN+1),D ; Store length of record PUSH IX POP HL ; HL' points to channel information LD BC,R_BUFFER ADD HL,BC ; HL' points to the R-channel buffer ADD HL,DE ; HL' points to byte following ; current record LD B,#05 ; B'=05, signalling "Standard RAM" EXX ; Use normal registers RES 1,(IX+R_CHFLAG) ; Signal "Not end of file block" EX AF,AF' RET NC ; Return unless end of file block SET 1,(IX+R_CHFLAG) ; Signal "End of file block" RET ; Return ; This subroutine actually assigns the R-channel buffer in preparation for use ; with a READ channel. Note that it calls the RTRANSFER subroutine from label ; RTRANSFE2 in order to deal with the zero case, when the buffer is to be ; considered empty. R_ASSIGN CALL R_MATCH ; Match buffer with RAMdisc segment CALL RTRANSFE2 ; Copy bytes into buffer RBUFFEXIT LD (IX+R_CHBYTE+0),#00 LD (IX+R_CHBYTE+1),#00 ; Reset pointer into buffer RET ; Return ; There now follows the INPUT routine for channel R. It isolates INPUT from ; INKEY$ and deals with each accordingly. R_INPUT LD HL,(ERR_SP) ; HL points to error return address LD E,(HL) INC HL LD D,(HL) ; DE=error return address LD HL,ED_ERROR AND A SBC HL,DE JR NZ,R_INKEY ; Jump if dealing with INKEY$ LD SP,(ERR_SP) ; Clear machine stack as far as ; return from EDITOR routine POP HL POP HL LD (ERR_SP),HL ; Restore normal error return address R_INPLOOP CALL R_INKEY ; Input a single character into A CP #0D RET Z ; Return if character is "enter" BIT 7,(IY+FLAGX) JR NZ,R_INPUT_2 ; Jump if doing INPUT LINE CP #22 JR NZ,R_INPUT_2 ; Jump unless character is "quotes" CALL ADD_CHAR_1 ; Register quotes twice R_INPUT_2 CALL ADD_CHAR_1 ; Insert character into INPUT area JR R_INPLOOP ; Loop back to input rest of string ; The following routine inputs a single character from an R-channel and returns ; it in the A register. R_INKEY CALL SWAP ; Page in ROM 0 LD HL,(RETADDR) PUSH HL ; Stack return address in ROM 0 EXX PUSH BC PUSH DE PUSH HL ; Stack alternative register set LD IX,(CURCHL) ; IX points to channel information BIT 0,(IX+R_CHFLAG) JR Z,R_INKEY_2 ; Jump if this is a READ file R_ERROR CALL V_ERROR ; Generate report code DEFB #1D ; "b Wrong file type" R_INKEY_2 LD E,(IX+R_CHBYTE+0) LD D,(IX+R_CHBYTE+1) ; DE=position of next byte to read BIT 1,(IX+R_CHFLAG) JR Z,RINKYREAD ; Jump unless this is an EOF block LD L,(IX+R_RECLEN+0) LD H,(IX+R_RECLEN+1) ; HL=length of current record AND A SBC HL,DE JR NZ,RINKYREAD ; Jump unless we have reached the ; end of the (EOF) record CALL V_ERROR ; Generate error report DEFB #07 ; "8 End of file" RINKYREAD PUSH IX POP HL ; HL points to channel information LD BC,R_BUFFER ADD HL,BC ; HL points to buffer ADD HL,DE ; HL points to next byte to read LD A,(HL) ; A=byte which INKEY$ must return PUSH AF INC DE ; Increment pointer LD (IX+R_CHBYTE+0),E LD (IX+R_CHBYTE+1),D ; Store incremented pointer DEC D DEC D JR NZ,RINKYEXIT ; Jump unless buffer to be renewed INC (IX+R_CHREC) ; Increment record number CALL R_ASSIGN ; Assign and reset buffer RINKYEXIT POP AF ; A=byte just read from buffer SCF ; Set Carry, so that INKEY$ # works ; properly RINOUEXIT POP HL POP DE POP BC EXX ; Restore alternative registers R_EXIT POP HL ; HL=return address into ROM 0 LD (RETADDR),HL ; Store in system variable JP SWAP ; Page in ROM 1 and return ; The next subroutine is designed to insert additional bytes into an already ; existing file stored in RAMdisc. Any files which need to be moved in order to ; make room for these extra bytes will be so moved, and re-indexed to ; accomodate. The subroutine should be entered with AHL containing the ; page-coded address at which to insert the bytes, and BC containing the number ; of bytes to insert. RMAKEROOM PUSH BC ; Stack number of bytes to insert PUSH HL PUSH AF ; Stack page-coded address at which to insert XOR A ; A=00, Carry flag reset LD H,A LD L,A ; AHL=zero SBC HL,BC SBC A,A ; AHL=minus no. of bytes to insert CALL V_SPACE ; Ensure enough room for extra bytes POP AF POP HL ; AHL=address at which to insert POP BC ; BC= number of bytes to insert PUSH BC PUSH HL PUSH AF LD A,#04 CALL V_PAGE ; Select page containing catalogue LD IX,(SF_NEXT) ; IX points to "End of cat" index LD L,(IX+SF_START+0) LD H,(IX+SF_START+1) LD A,(IX+SF_START+2) ; AHL=page-coded address of first ; spare byte in RAMdisc area PUSH AF PUSH HL ; Stack this address CALL ADD_HL_BC ; AHL= page-coded address of first ; RAMdisc byte which will remain spare ; after more bytes are inserted LD B,A ; BHL =this address EXX ; BHL'=this address POP HL POP BC ; BHL points to 1st spare byte (old) POP AF POP DE ; ADE=address at which to insert LD C,A ; CDE=address at which to insert PUSH DE PUSH AF ; Stack this address CALL RTRANSFE2 ; Move bytes which need to be moved LD A,#04 CALL V_PAGE ; Select page containing catalogue POP BC POP DE ; BDE=position of insertion R_MR_LOOP LD L,(IX+SF_START+0) ; AHL=previous page-coded address of LD H,(IX+SF_START+1) ; a RAMdisc file (or next spare byte) LD A,(IX+SF_START+2) ; which may have been moved CP B JR C,R_MRFOUND ; Jump if file address precedes ; point of insertion SBC HL,DE ADD HL,DE JR C,R_MRFOUND ; Jump if file address precedes ; point of insertion EX DE,HL EX (SP),HL EX DE,HL ; DE=number of bytes inserted ADD HL,DE JR NC,R_MR_ADDR SET 7,H SET 6,H INC A ; AHL=new address of file R_MR_ADDR EX DE,HL EX (SP),HL EX DE,HL ; BDE=position of insertion LD (IX+SF_START+0),L LD (IX+SF_START+1),H LD (IX+SF_START+2),A ; Store new start address of file PUSH BC LD BC,#0014 ADD IX,BC ; IX points to index for next file POP BC ; BDE=position of insertion LD (IX+SF_END+0),L LD (IX+SF_END+1),H LD (IX+SF_END+2),A ; Store new address for next file JR R_MR_LOOP ; Loop back to deal with this file R_MRFOUND LD L,(IX+SF_LEN+0) LD H,(IX+SF_LEN+1) LD A,(IX+SF_LEN+2) ; AHL=previous length of file EX DE,HL EX (SP),HL EX DE,HL ; DE= number of bytes inserted ADD HL,DE ADC A,#00 ; AHL=new length of file LD (IX+SF_LEN+0),L LD (IX+SF_LEN+1),H LD (IX+SF_LEN+2),A ; Store new length of file LD A,B ; A=page-code of point of insertion LD B,D LD C,E ; BC= number of bytes inserted POP HL ; AHL=page-coded address of point ; at which bytes were inserted RET ; Return ; The following subroutine will transfer the contents of the R-channel buffer ; into the corresponding RAMdisc file. R_STORE LD C,(IX+R_CHBYTE+0) LD B,(IX+R_CHBYTE+1) ; BC=number of bytes in buffer PUSH IX ; Stack address of R-channel info PUSH BC ; Stack number of bytes in buffer CALL FIND_FILE ; IX points to file entry in cat. POP BC ; BC=number of bytes in buffer LD L,(IX+SF_END+0) LD H,(IX+SF_END+1) LD A,(IX+SF_END+2) ; AHL=page-coded address of first ; byte beyond end of file CALL RMAKEROOM ; Insert enough room for contents of buffer POP IX ; IX points to channel information CALL ADD_HL_BC ; AHL points one byte beyond the ; last of the new bytes PUSH BC ; Stack number of bytes in buffer LD B,A ; BHL= address of last new byte + 1 EXX ; BHL'=address of last new byte + 1 PUSH IX POP HL ; HL=address of channel information LD BC,R_BUFFER ADD HL,BC ; HL points to start of buffer POP BC ; BC= number of bytes in buffer PUSH HL ; Stack address of start of buffer ADD HL,BC ; HL points to byte beyond buffer POP DE ; DE points to start of buffer LD BC,#0505 ; BHL and CDE now page-coded addresses CALL RTRANSFE2 ; Copy buffer into RAMdisc area LD A,B ; A=05 CALL V_PAGE ; Page in normal RAM JP RBUFFEXIT ; Reset pointer into buffer and return ; Now comes the output routine, whose job it is to print the character stored ; in the A register to an R channel (ie. to store it firstly in the buffer, and ; ultimately in a RAMdisc file). R_PRINT CALL SWAP ; Page in ROM 0 LD HL,(RETADDR) PUSH HL ; Stack return address into ROM 0 EXX PUSH BC PUSH DE PUSH HL ; Stack alternative register set LD IX,(CURCHL) ; IX points to channel information BIT 0,(IX+R_CHFLAG) JP Z,R_ERROR ; Error if this is a READ file LD E,(IX+R_CHBYTE+0) LD D,(IX+R_CHBYTE+1) ; DE=number of bytes in buffer PUSH IX POP HL ; HL points to channel information LD BC,#001B ADD HL,BC ; HL points to start of buffer ADD HL,DE ; HL points to next spare byte LD (HL),A ; Store byte in buffer INC DE ; DE=new number of bytes in buffer LD (IX+R_CHBYTE+0),E LD (IX+R_CHBYTE+1),D ; Store new number of chars in buffer DEC D DEC D CALL Z,R_STORE ; If buffer is now full, then empty ; contents into RAMdisc file AND A ; Reset Carry JP RINOUEXIT ; Jump to exit routine ; Next we have the routine to CLOSE an R channel. All that is necessary is that ; the buffer contents be ignored (READ file) or stored in RAMdisc (WRITE file). R_FLUSH CALL SWAP ; Page in ROM 0 LD HL,(RETADDR) PUSH HL ; Stack return address into ROM 0 PUSH IX ; Stack pointer to channel info LD HL,(ERR_SP) ; HL points to error return address PUSH HL ; Stack this pointer LD HL,#FFFE ADD HL,SP ; HL=SP minus two LD (ERR_SP),HL ; Set new error return address BIT 0,(IX+R_CHFLAG) CALL NZ,R_STORE ; If this is a WRITE file, then empty ; buffer contents into RAMdisc POP HL ; NOTE: This is also the return point ; from any errors that may have ; occurred during R_STORE LD (ERR_SP),HL ; Restore error pointer to normal POP IX ; Restore channel info pointer R_OC_EXIT LD HL,#2758 EXX ; HL'=#2758 to prevent crash JP R_EXIT ; Jump to exit routine ; OPEN RAMDISC CHANNEL ; -------------------- ; At last we have the routine to OPEN an R channel. On entry ; A = the stream number to which the channel is to be attached ; N_STR1 = the 10-byte filename of the READ or WRITE file to be opened ; If the filename is less than 10 characters long then it should be followed ; by trailing spaces. ; R_OPEN CALL SWAP ; Page in ROM 0 LD HL,(RETADDR) PUSH HL ; Stack return address into ROM 0 PUSH AF ; Stack stream number LD A,"R" ; A=name of this channel ("R") CALL SEARCHALL ; Search for an existing R channel JR C,R_OP_OK ; Jump if none found R_OP_LOOP PUSH IX POP HL ; HL points to channel information ; for already existing R channel LD BC,R_CHNAME ADD HL,BC ; HL points to filename for ; already existing R channel LD DE,N_STR1 ; DE points to intended filename ; for this channel LD B,#0A ; B=length of filename R_OP_NAME LD A,(DE) INC DE CP (HL) INC HL JR NZ,R_OPRETRY ; Jump if filenames are different DJNZ R_OP_NAME ; Test all 10 characters of filename. ; If filenames are identical then R_OPERROR CALL V_ERROR ; generate error report DEFB #20 ; "e File already exists" R_OPRETRY LD D,"R" ; D=name of this channel ("R") CALL SEARCHNXT ; Search for next existing R channel JR NC,R_OP_LOOP ; Loop back if one found R_OP_OK CALL V_FIND ; Search for RAMdisc file with ; given name PUSH AF ; Stack the Zero flag JR Z,R_OP_CONT ; Jump if no file found (ie. if this ; is to be a WRITE file) LD L,(IX+SF_START+0) LD H,(IX+SF_START+1) ; [The next line was incorrectly printed as DD7E0B in the magazine. JimG] LD A,(IX+SF_START+2) ; AHL=page-coded addr of file with given name CALL V_PAGE ; Select page containing first byte of this file LD A,(HL) ; A=file type code CP #04 JR NZ,R_OPERROR ; Give error unless a READ file R_OP_CONT LD A,#05 CALL V_PAGE ; Page in normal RAM POP AF ; Retrieve Zero flag EX AF,AF' ; Store in A' POP AF ; A= stream number EX AF,AF' ; A'=stream number PUSH AF ; Stack the Zero flag, which determines ; whether this is a READ or WRITE file LD A,"R" ; A= name of this channel ("R") LD BC,R_BUFFER+#200 ; BC=length of channel info block LD DE,R_INPUT ; DE=address of input routine LD HL,R_PRINT ; HL=address of output routine LD IX,R_FLUSH ; IX=address of close routine RST #28 ; Call routine with ROM 1 paged in DEFW OPEN_NEW ; Create channel information block PUSH IX POP HL ; HL points to channel information LD BC,R_CHBYTE ADD HL,BC ; HL points to variable R_CHBYTE LD (HL),B INC HL LD (HL),B ; Reset R_CHBYTE INC HL LD (HL),B ; Reset R_CHREC INC HL ; HL now points to R_CHNAME EX DE,HL ; DE points to R_CHNAME LD HL,N_STR1 ; HL points to supplied filename LD C,#0A ; DE= length of filename (ten) LDIR ; Copy filename into channel info POP AF ; Retrieve Zero flag JR Z,R_OPWRITE ; Jump if this is to be a WRITE file RES 0,(IX+R_CHFLAG) ; Signal "This is a READ file" CALL R_ASSIGN ; Assign buffer from RAMdisc file JR R_OP_EXIT ; Jump to exit routine R_OPWRITE SET 0,(IX+R_CHFLAG) ; Signal "This is a WRITE file" CALL V_NEWCAT ; Create new catalogue entry LD HL,#FFFF LD A,H ; AHL=minus one CALL V_SPACE ; Ensure enough room for one byte LD A,#04 CALL V_PAGE ; Select page containing catalogue LD L,(IX+SF_START+0) LD H,(IX+SF_START+1) LD A,(IX+SF_START+2) ; AHL=page-coded address of first ; spare byte in RAMdisc PUSH AF ; Stack page-code CALL V_PAGE ; Select page containing first ; spare byte in RAMdisc POP AF ; AHL points to first spare byte LD (HL),#04 ; Store filetype #04 as type-of-file code LD BC,#0001 CALL ADD_HL_BC ; AHL= page-coded address of new ; first spare byte in RAMdisc LD E,A ; EHL= this address LD A,#04 CALL V_PAGE ; Select page containing catalogue LD (IX+SF_END+0),L LD (IX+SF_END+1),H LD (IX+SF_END+2),E ; Store address of end of file CALL V_CATEND ; Tidy up catalogue entry LD A,#05 CALL V_PAGE ; Select normal RAM R_OP_EXIT JP R_OC_EXIT ; Jump to exit routine ; DEMO ROUTINES ; ------------- ; And finally, we have the routines which integrate the R channel with BASIC. ; These are only example routines, and you may of course rewrite them to your ; own specifications. OPEN_4 will open stream four to a serial file called ; FILE1, OPEN_5 will open stream five to a serial file called FILE2, CLOSE_4 ; will close stream four, and CLOSE_5 will close stream five. FILE_1 DEFM "FILE1 " ; Name of first file FILE_2 DEFM "FILE2 " ; Name of second file OPEN_4 LD A,#04 ; A=stream number LD HL,FILE_1 ; HL points to filename JR OPEN_4_5 ; Jump to open stream OPEN_5 LD A,#05 ; A=stream number LD HL,FILE_2 ; HL points to filename OPEN_4_5 LD DE,N_STR1 ; DE points to system variable LD BC,#000A ; BC=length of filename (ten) LDIR ; Copy filename into system variable JP OPEN_R CLOSE_4 LD A,#04 ; A=stream number JR CLOSE_4_5 CLOSE_5 LD A,#05 ; A=stream number CLOSE_4_5 JP CLOSE ; Jump to close channel ; And finally - just a quick demonstration program to open a window and attach ; it to stream four. If you call this you'll be able to use PRINT #4 to print ; to the the window. WIND_DEMO LD A,#04 EX AF,AF' ; A'= stream number LD HL,(UDG) ; HL= address of user-defined graphics LD BC,#FF80 ADD HL,BC LD B,H LD C,L ; BC'= address of UDGs minus #80 LD DE,(CHARS) ; DE'= addrress of normal char set minus #100 LD H,#07 ; H' = width of characters EXX LD A,#31 ; A = attribute byte for window LD BC,#0201 ; BC= position of window LD DE,#0818 ; DE= size of window LD HL,#FFFF ; HL signals "Slow window" and ; "Scroll pause enabled" EX AF,AF' ; A=stream CALL OPEN_W ; Open the window channel LD HL,#2758 EXX ; HL'= value required by BASIC RET ; Return DEFW START DEFW DEMO_1