TITLE ( MSX ROM BASIC BIOS ) PAGE 36 .list ; ; (C) Copyright by ASCII Corp., 1983 ; Proprietary information. All rights reserved. ; ; File: BIOHDR.MAC ; USE: Restart calls and ROM entries table ; Written by Jey Suzuki, Rick Yamashita ; ASCII Corporation, Japan ; ; Edit: January, 1985 ; Reason: Zilog Z80 Mnemonic version and cleanup ; Edited by: Steven M. Ting ; ; Labels referenced in this listing, are the absolute locations ; within the MSX ROM. However, "ONLY" this BIOS entry point table, ; and RAM variables are guaranteed to be permanent. ; ; All other locations in the ROM, will be changed without notice. ; SUBTTL -BIOS header- BIOS calls (Basic Interpreter, Slot I/O) ; ; The following RST's (RST 0 thru RST 5) are reserved for BASIC ; interpreter, RST 6 for inter-slot calls, and RST 7 for ; hardware interrupt ; BEGIN: DI ;Fail safe JP CHKRAM ;Finds all connected RAM ;and cartridges ; ; ; ** Special information for the VDP. ** ; Any program that accesses the VDP hardware directly ; should read the I/O port address found here, to be certain ; the software is compatible with future versions of the VDP. ; DW CGTABL ;Address of character generator table, ;to allow use of other character ROM. ; DB 98H ;Current port address for VDP Data read DB 98H ; " " " " " " write ; JP SYNCHR ;Check byte following the RST 8, see ;if equal to the byte pointed by HL DB 0 JP RDSLT ;Read a byte from another slot DB 0 JP CHRGTR ;Fetch next char from BASIC text DB 0 JP WRSLT ;Write a byte to another slot DB 0 JP OUTDO ;Output a char to the Console or printer DB 0 JP CALSLT ;Perform Inter-slot call DB 0 JP DCOMPR ;Comperes [HL] to [DE] DB 0 JP ENASLT ;Permanently enables a slot DB 0 JP GETYPR ;Returns the [FAC] type DB 0 ;ID Byte (1) ;Format: ; B7 B6 B5 B4 B3 B2 B1 B0 ; + + + + + + + + ; + + + + - - - - - - Type of character ; + + + + generator. ; + + + + 0:Japanese ; + + + + 1:International ; + + + + 2:Korea ; + + - - - - - - - - - Date format ; + + 0: Y-M-D 1: M-D-Y ; + + 2: D-M-Y ; - - - - - - - - - - - - Interrupt frequency ; 0: 60 Hz 1: 50 Hz DB 0 ;ID Byte (2) ;Format: ; B7 B6 B5 B4 B3 B2 B1 B0 ; + + + + + + + + ; + + + + - - - - - - Type of Keyboard ; + + + + 0:Japanese 2:French ; + + + + 1:Int 3:UK ; + + + + 4:DIN ; - - - - - - - - - - - - Version of BASIC ; 0: Japanese ; 1: International DB 0,0,0 JP CALLF ;Performs Far-call (i.e., Inter-slot) DB 0,0,0,0,0 ; ; ; Following are used for I/O initialization ; JP KEYINT ;Handlers for hardware interrupt JP INITIO ;Do device initialization JP INIFNK ;Reset all function key's text ; SUBTTL -BIOS header- BIOS calls (Video display processor) ; ; The following entry points provides control of the ; VDP's registers, screen mode settings, and memory block ; move between DRAM and VRAM. ; JP DISSCR ;Disables screen display JP ENASCR ;Enables screen display JP WRTVDP ;Write a byte to any VDP register JP RDVRM ;Read VRAM addressed using [HL] JP WRTVRM ;Write VRAM addressed using [HL] JP SETRD ;Sets up VDP for read JP SETWRT ;Sets up VDP for write JP FILVRM ;Fills VRAM with specified data JP LDIRMV ;Moves block of data from VRAM to memory JP LDIRVM ; " " " " " memory to VRAM JP CHGMOD ;Change screen mode of VDP to [SCRMOD] JP CHGCLR ;change Foreground, background, ;border, color DB 0 ; ; JP NMI ;Handler for non -maskable interrupt ; JP CLRSPR ;Init sprite data JP INITXT ;Init VDP for 40 X 24 text mode (SCREEN 0) JP INIT32 ; " " " 32 X 24 text mode (SCREEN 1) JP INIGRP ; " " " High resolution mode (SCREEN 2) JP INIMLT ; " " " Multi color mode (SCREEN 3) JP SETTXT ;Sets VDP to display 40 X 24 text mode JP SETT32 ; " " " " 32 X 24 text mode JP SETGRP ; " " " " High-res mode JP SETMLT ; " " " " Multi color mode JP CALPAT ;Get address of sprite pattern table JP CALATR ; " " " " attribute table JP GSPSIZ ;Returns current sprite size JP GRPPRT ;Print a character on the graphic screen ; SUBTTL -BIOS header- BIOS calls (Programmable Sound Generator control) ; ; Following entry points are used for PSG initialization, ; read and write PSG registers, and PLAY statement execution. ; JP GICINI ;Init PSG, and static data for PLAY JP WRTPSG ;Write data to PSG JP RDPSG ;Read data from PSG JP STRTMS ;Checks and start background task for PLAY ; SUBTTL -BIOS header- BIOS calls (Keyboard, CRT, and Printer) ; ; General INPUT and PRINT utilities. ; JP CHSNS ;Checks status of keyboard status JP CHGET ;Return char typed, with wait JP CHPUT ;Output character to console JP LPTOUT ; " " to printer, if possible JP LPTSTT ;Checks status of line printer JP CNVCHR ;Checks for graphic header byte ;and convert code JP PINLIN ;Read line from keyboard to buffer JP INLIN ;Same as above, except in case of ;AUTFLG is set JP QINLIN ;Print a "?", then jump to INLIN JP BREAKX ;[Control-STOP] pressed?? JP ISCNTC ;[Shift-STOP] pressed?? JP CKCNTC ;Same as ISCNTC, but used by BASIC JP BEEP ;Buzz JP CLS ;Clear screen JP POSIT ;Place cursor at Column [H], Row [L] JP FNKSB ;Display Function key, if neccessary JP ERAFNK ;Stop displaying the Function keys JP DSPFNK ;Enable Function key display JP TOTEXT ;Force screen to text mode ; SUBTTL -BIOS header- BIOS calls (Game and Cassette I/O, Queue handler) ; ; Following are used to read the value from Joysticks, ; Graphic pad (tablet), and Paddles. ; JP GTSTCK ;Return status of joystick JP GTTRIG ;Read joystick trigger button JP GTPAD ;Returns status of graphic pad JP GTPDL ;Read paddle ; ; ; Following are used to access the cassette tape, ; data read/write, and motor on/off ; JP TAPION ;Turn on motor and read tape header JP TAPIN ;Read tape data JP TAPIOF ;Stops reading from tape JP TAPOON ;Turn on motor and write tape header JP TAPOUT ;Write data to tape JP TAPOFF ;Stops writing to tape JP STMOTR ;Start, stop cassette motor, or ;flip motor(on to off, off to on) ; ; ; BASIC queues ; JP LFTQ ;Bytes left in queue JP PUTQ ;Send a byte to queue ; SUBTTL -BIOS header- BIOS calls (Generalized graphics) ; ; For BASIC interpreter's GENGRP and ADVGRP modules use JP RIGHTC ;Moves one pixel right JP LEFTC ; " " " left JP UPC ; " " " up JP TUPC ; " " " " JP DOWNC ; " " " down JP TDOWNC ; " " " " JP SCALXY ;Scales X Y cordinates JP MAPXYC ;Maps cordinates to physical address JP FETCHC ;Get current physical address and ;mask pattern JP STOREC ;Put current physical address and ;mask pattern JP SETATR ;Sets the color attribute byte JP READC ;Reads attribute of current pixel JP SETC ;Sets current pixel to specified attribute JP NSETCX ;Sets pixel horizontally JP GTASPC ;Returns aspect ratio JP PNTINI ;Do paint initialization JP SCANR ;Scan pixels to the right JP SCANL ; " " " " left ; SUBTTL -BIOS header- BIOS calls (Misc. Entries) ; ; JP CHGCAP ;Turn [CAPSLOCK] light, on/off JP CHGSND ;Change status of 1 bit sound port JP RSLREG ;Return output of primary slot register JP WSLREG ;Write to primary slot register JP RDVDP ;Read VDP status register JP SNSMAT ;Read a specified row in the ;keyboard matrix JP PHYDIO ;Performs operation for mass storage ;devices (such as disks) JP FORMAT ;Initialize mass storage device JP ISFLIO ;Are we doing device I/O JP OUTDLP ;Output to line printer JP GETVCP ;Used by Music background tasking JP GETVC2 ; " " " " " JP KILBUF ;Clear the keyboard buffer JP CALBAS ;Performs far-call into BASIC DS 005AH ;RESERVED FOR EXPANSION ; SUBTTL - SLOT - Slot handler stuff ;PPI.AR EQU 0A8h ;A8H read from PPI Port A ;PPI.AW EQU 0A8h ;A8H Write to PPI Port A ; ; Every cartridge located at 0000-3FFFH must contain codes in ; this module which are entered via following addresses. ; ; 000CH RDSLT ; 0014H WRSLT ; 001CH CALSLT ; 0024H ENASLT ; ; ; ------------------------------ RDSLT ------------------------------ ; ; Selects the appropriate slot according to the value given ; through registers, and read the content of memory from the ; slot. ; ; Input parameters: ; A - FxxxSSPP ; | |||| ; | ||++-- primary slot # (0-3) ; | ++---- secondary slot # (0-3) ; +--------- 1 if secondary slot # specified ; ; HL - address of target memory ; Returned value ; A - content of memory ; ; Note: Interrupts are disabled automatically but never enabled ; by this routine. ; RDSLT: CALL SELPRM ;Calculate bit pattern and mask code JP M,RDESLT ;Expanded slot specified IN A,(PPI.AR) LD D,A ;Save current setting AND C ;Cancel current setting for target address OR B ;Add new setting CALL RAMLOW ;Call read primitive routine (in system area) LD A,E ;Return value via [Acc] RET RDESLT: PUSH HL ;Save target address CALL SELEXP ;Select secondary slot EX (SP),HL ;Restore target address and save [HL] PUSH BC CALL RDSLT JR WRESED ;Restore old slot select register SUBTTL -SLOT- Slot handler (Write slot) ; ; ------------------------------ WRSLT ------------------------------ ; ; Selects the appropriate slot according to the value given ; through registers, and write to the memory in the specified ; slot. ; ; Input parameters: ; A - FxxxSSPP ; | |||| ; | ||++-- primary slot # (0-3) ; | ++---- secondary slot # (0-3) ; +--------- 1 if secondary slot # specified ; ; HL - address of target memory ; ; E - value to be written ; ; Note: Interrupts are disabled automatically but never enabled ; by this routine. ; WRSLT: PUSH DE ;Save data to be written CALL SELPRM ;Calculate bit pattern and mask code JP M,WRESLT ;Expanded slot specified POP DE ;Restore data to be written IN A,(PPI.AR) LD D,A ;Save current setting AND C ;Cancel current setting for target address OR B ;Add new setting JP WRPRIM ;Call write primitive routine (in system area) WRESLT: EX (SP),HL ;Save target address, get data to be written PUSH HL ;Save data to be written CALL SELEXP ;Select secondary slot POP DE ;Restore data to be written EX (SP),HL ;Restore target address and save [HL] PUSH BC CALL WRSLT WRESED: POP BC EX (SP),HL ;Save target address and get old [HL] PUSH AF ;Save value returned by RDSLT LD A,B ;Get current setting AND 00111111B ;Cancel current setting for 0C000H..0FFFFH OR C OUT (PPI.AW),A ;Enable 00000H..0FFFFH of target bank LD A,L ;Restore old setting of slot register LD (0FFFFH),A LD A,B ;Finally restore old primary slot register OUT (PPI.AW),A POP AF ;Restore value returned by RDSLT POP HL ;Restore target address RET CALBAS: LD IY,(EXPTBL-1) JR CALSLT CALLF: EX (SP),HL ;Get return address, save [HL] PUSH AF ;Save working registers PUSH DE LD A,(HL) ;Get destination slot PUSH AF POP IY ;Move it to IYH INC HL LD E,(HL) ;Get destination address INC HL LD D,(HL) INC HL ;Prepare true return address PUSH DE POP IX ;Move it to IX POP DE ;Restore working registers POP AF EX (SP),HL ;Resture [HL], save true return address SUBTTL -SLOT- ; ; ------------------------------ CALSLT ------------------------------ ; ; Performs inter-slot call to specified address. ; ; Input parameters: ; IY - FxxxSSPP ; | |||| ; | ||++-- primary slot # (0-3) ; | ++---- secondary slot # (0-3) ; +--------- 1 if secondary slot # specified ; ; IX - address to call ; ; Note: Interrupts are disabled automatically but never enabled ; by this routine. ; You can never pass arguments via alternate registers ; of Z80. ; CALSLT: EXX ;Save environments EX AF,AF' PUSH IY POP AF ;Get target slot information PUSH IX POP HL ;Get target address CALL SELPRM JP M,CALESL ;Call expanded slot IN A,(PPI.AR) PUSH AF ;Save current value of primary slot register AND C ;Cancel current setting for target address OR B ;Add new setting EXX ;Restore environments except PSW JP CLPRIM ;Jump to primitive routine (in system area) CALESL: CALL SELEXP ;Select secondary slot register PUSH AF ;Move primary slot # in [IYH] POP IY PUSH HL ;Save [B,C,L] which contain information PUSH BC ;for restoring slot environments LD C,A ;Move primary slot # to [BC] LD B,0 LD A,L ;Re-calculate what is currently output AND H ;to expansion slot register OR D LD HL,SLTTBL ;Calculate address into SLTTBL ADD HL,BC LD (HL),A ;Set current value output to expansion ;slot register PUSH HL ;Remember this address EX AF,AF' ;Restore possible arguments passed EXX ;via registers CALL CALSLT ;Call by primary slot # EXX ;Save possible values returned via EX AF,AF' ;registers POP HL ;Restore address into SLTTBL POP BC ;Restore information about old slots POP DE LD A,B ;Get current setting AND 00111111B ;Cancel current setting for 0C000H..0FFFFH OR C DI OUT (PPI.AW),A ;Enable 0C000H..0FFFFH of target bank LD A,E ;Restore old setting of slot register LD (0FFFFH),A LD A,B ;Finally restore old primary slot register OUT (PPI.AW),A LD (HL),E ;And change SLTTBL also EX AF,AF' ;Restore possible returned values EXX RET ; ; ------------------------------ ENASLT ------------------------------ ; ; Selects the appropriate slot according to the value given ; through registers, and permanently enables the slot. ; ; Input parameters: ; ; A - FxxxSSPP ; | |||| ; | ||++-- primary slot # (0-3) ; | ++---- secondary slot # (0-3) ; +--------- 1 if secondary slot # specified ; ; HL - address of target memory ; ; Note: Interrupts are disabled automatically but never enabled ; by this routine. ; ENASLT: CALL SELPRM ;Calculate bit pattern and mask code JP M,ENESLT ;Expanded slot specified IN A,(PPI.AR) AND C ;Cancel current setting for target address OR B ;Add new setting OUT (PPI.AW),A RET ENESLT: PUSH HL ;Save target address CALL SELEXP ;Select secondary slot LD C,A ;Move primary slot # to [BC] LD B,0 LD A,L ;Re-calculate what is currently output AND H ;to expansion slot register OR D LD HL,SLTTBL ;Calculate address into SLTTBL ADD HL,BC LD (HL),A ;Set current value output to expansion ;slot register POP HL ;Restore target address LD A,C ;Restore primary slot # to [Acc] JR ENASLT ;Enable by primary slot register SELPRM: DI PUSH AF ;Save slot address LD A,H ;Extract upper 2 bits RLCA RLCA AND 00000011B LD E,A LD A,0C0H ;Format mask pat; correspond to address SLPRM1: RLCA RLCA DEC E JP P,SLPRM1 LD E,A ;Save mask pattern ; 00000011 0000-3FFF ; 00001100 4000-7FFF ; 00110000 8000-BFFF ; 11000000 C000-FFFF CPL LD C,A ;Save mask pattern ; 11111100 0000-3FFF ; 11110011 4000-7FFF ; 11001111 8000-BFFF ; 00111111 C000-FFFF POP AF ;Restore slot address PUSH AF AND 00000011B ;Extract primary slot # INC A LD B,A LD A,10101011B ;Convert slot # to proper bit pattern SLPRM2: ADD A,01010101B DJNZ SLPRM2 LD D,A ;Save bit pattern for primary slot # ; 00000000 slot #0 ; 01010101 slot #1 ; 10101010 slot #2 ; 11111111 slot #3 AND E ;Extract significant bits LD B,A ;Set it to [B] POP AF ;Expanded slot specified? AND A ;Set sign flag if so RET SELEXP: PUSH AF ;Save target slot LD A,D ;Get bit pattern for primary slot AND 1000000B ;Extract slot # for 0C000H..0FFFFH LD C,A ;Save it POP AF ;Restore target slot PUSH AF ;Save target slot LD D,A ;Load [D] with specified slot address IN A,(PPI.AR) LD B,A ;Save current setting AND 00111111B ;Cancel current setting for 0C000H..0FFFFH OR C OUT (PPI.AW),A ;Enable 0C000H..0FFFFH or target bank LD A,D ;Load slot information RRCA RRCA AND 00000011B ;Extract secondary slot # LD D,A LD A,10101011B ;Convert secondary slot # to proper SLEXP1: ADD A,01010101B ;bit pattern DEC D JP P,SLEXP1 ; 00000000 slot #0 ; 01010101 slot #1 ; 10101010 slot #2 ; 11111111 slot #3 AND E ;Make bit pattern to be added LD D,A ;Save this LD A,E ;Make bit pattern to strip off old value CPL LD H,A ;Save this LD A,(0FFFFH) ;Read expanded slot register CPL LD L,A ;Save current setting AND H ;Strip off old bits OR D ;And set new bits LD (0FFFFH),A ;Set secondary slot register LD A,B OUT (PPI.AW),A ;Restore original primary port POP AF ;Restore target slot AND 00000011B ;Fake read from primary slot RET SUBTTL - MSXIO - I/O Module ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ; Port definition ; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; VDP address definition ; VDP.DRW EQU 10011000B ;98H Read/write data VDP VDP.CW EQU 10011001B ;99H write command to VDP VDP.SR EQU 10011001B ;99H read status from VDP ; V.COLR EQU 7 ;In text mode, foreground and background color ;Otherwise background color ; ; PSG address definition ; PSG.LW EQU 10100000B ;A0H latch address for PSG PSG.DW EQU 10100001B ;A1H write data to PSG PSG.DR EQU 10100010B ;A2H read data from PSG ; PSG.PA EQU 14 ;Port A of PSG PSG.PB EQU 15 ;Port B of PSG ; ; PPI address definition ; PPI.AR EQU 10101000B ;A8H read from PPI Port A PPI.BR EQU 10101001B ;A9H read from PPI Port B PPI.CR EQU 10101010B ;AAH read from PPI Port C PPI.AW EQU 10101000B ;A8H Write to PPI Port A PPI.CW EQU 10101010B ;AAH write to PPI Port C PPI.CM EQU 10101011B ;ABH write to PPI command register ; ; Printer port definition ; LPT.DW EQU 10010001B ;91H Data port LPT.SB EQU 10010000B ;90H Strobe output LPT.ST EQU 10010000B ;90H Printer status ; ; Text mode (40*24) SCREEN 0 ; ; TXTNAM,TXTCGP ; ; Text mode (graphics 1) SCREEN 1 ; ; T32NAM,T32COL,T32CGP,T32ATR,T32PAT ; ; Hires mode SCREEN 2 ; ; GRPNAM,GRPCOL,GRPCGP,GRPATR,GRPPAT ; ; Multi-color mode SCREEN 3 ; ; MLTNAM,MLTCGP,MLTATR,MLTPAT ; ; Screen size ; ; LINLEN,CRTCNT,LINL32,LINL40 ; ; External constants ; ; CGTABL Character generator table ; ; External variables ; ; FORCLR Foreground color ; BAKCLR Background color ; BDRCLR Border color for PAINT ; SCRMOD Current screen mode ; 0 - 40*24 text ; 1 - 32*24 text ; 2 - hiresolution graphics ; 3 - Multicolor graphics ; OLDSCR ; NAMBAS Base of current name table ; CGPBAS Base of current cgen table ; PATBAS Base of current sprite pattern table ; ATRBAS Base of current sprite attribute table ; JIFFY Jiffy count ; CLIKSW Click switch ; CLIKFL Click flag to suppress multiple key clicks ; RG0SAV VDP register #0 save area ; RG1SAV VDP register #1 save area ; STATFL VDP status register ; PATWRK Work area for pattern converter ; ; External routines ; ; GETQ ; PUTQ ; INITQ SUBTTL - MSXIO - Find available RAM CHKRAM: ; ; ------------------------------ CHKRAM ------------------------------ ; ; Look into every slot from 0FFFFH to C000H, and set system work ; area. Note that we cannot use RAM as work area nor perform ; subroutine call 'cause we do not yet know where the available ; RAM exits. Everything has to be done inside ROM and CPU's ; register until the RAM is found. ; LD A,82H ;Port A - output (mode 0) OUT (PPI.CM),A ;Port B - input (mode 0) XOR A ;Port C - output (mode 0) OUT (PPI.AW),A ;Select slot 0 for all addresses LD A,'P' ;Disable all cassette related outputs OUT (PPI.CW),A ;Motor off ; ; Start searching ; ; Register usage: ; B - non 0 if we're now checking secondary slot ; SPH - slot # of the biggest RAM block ; SPL - secondary slot # of the biggest RAM block (if any) ; DE - lowest address of the biggest RAM block ever found ; C - 'slot-expanded' flag ; ; 0000xxxx ; |||| ; |||+- slot #3 expanded ; ||+-- slot #2 expanded ; |+--- slot #1 expanded ; +---- slot #0 expanded ; LD DE,0FFFFH ;Initialize lowest address ever found XOR A ;Start from slot #0 LD C,A ;Clear bit pattern CKRM05: OUT (PPI.AW),A ;Select the slot SLA C ;Shift bit pattern LD B,0 ;Assume this slot is not expanded LD HL,0FFFFH ;Read from possible expansion slot register LD (HL),0F0H ;Write a binary 11110000 LD A,(HL) SUB 0FH ;Read back as 00001111? JR NZ,CKRM15 ;Nop, this is not an expanded slot LD (HL),A ;Write 00000000 LD A,(HL) INC A ;Read back as 11111111? JR NZ,CKRM15 ;Nop, not expanded slot INC B ;We're checking expanded slot SET 0,C ;Say this slot is expanded CKRM10: ; ;Start from expansion slot #0 ; LD (0FFFFH),A ;Select the expanded slot CKRM15: LD HL,0BF00H ;Start checking from 0BF00H to 8000H CKRM20: LD A,(HL) CPL LD (HL),A CP (HL) CPL LD (HL),A JR NZ,CKRM25 ;RAM not equipped in this page INC L ;Make sure it's not a coincidence JR NZ,CKRM20 ;Check more DEC H JP M,CKRM20 ;Check next page CKRM25: LD L,0 INC H LD A,L ;Below the one ever found SUB E LD A,H SBC A,D JR NC,CKRM30 ;No EX DE,HL ;Register this address as the lowest LD A,(0FFFFH) ;Set possible secondary slot # CPL LD L,A IN A,(PPI.AR) ;Set primary slot # LD H,A LD SP,HL ;Register these slot #'s CKRM30: LD A,B AND A ;Are we checking secondary slot JR Z,CKRM35 ;No LD A,(0FFFFH) CPL ADD A,10H ;Prepare to select next secondary slot CP 01000000B JR C,CKRM10 ;Continue if more secondary slots remain CKRM35: IN A,(PPI.AR) ADD A,01010000B ;Prepare to select next slot JR NC,CKRM05 ;Continue if more primary slots remain ; ; Check is done, select the biggest one ; LD HL,0 ADD HL,SP LD A,H OUT (PPI.AW),A ;Set primary slot register LD A,L LD (0FFFFH),A ;Set possible secondary slot register ; ; Next, check 0C000H..0FFFFH ; LD A,C RLCA RLCA RLCA RLCA LD C,A LD DE,0FFFFH ;Initialize lowest address ever found IN A,(PPI.AR) ;Start from slot #0 AND 00111111B CKRM50: OUT (PPI.AW),A ;Select the slot LD B,0 ;Assume this slot is not expanded RLC C ;Shift bit pattern JR NC,CKRM60 ;This slot is not expanded INC B ;We're checking expanded slot LD A,(0FFFFH) CPL AND 00111111B CKRM55: LD (0FFFFH),A ;Select the expanded slot CKRM60: LD HL,0FE00H ;Start checking from 0FE00H to 0C000H CKRM65: LD A,(HL) CPL LD (HL),A CP (HL) CPL LD (HL),A JR NZ,CKRM70 ;RAM not equipped in this page INC L ;Make sure it's not a coincidence JR NZ,CKRM65 ;Check more DEC H LD A,H CP 0C0H JR NC,CKRM65 ;Check next page CKRM70: LD L,0 INC H LD A,L ;Below the one ever found SUB E LD A,H SBC A,D JR NC,CKRM75 ;No EX DE,HL ;Register this address as the lowest LD A,(0FFFFH) ;Set possible secondary slot # CPL LD L,A IN A,(PPI.AR) ;Set primary slot # LD H,A LD SP,HL ;Register these slot #'s CKRM75: LD A,B AND A ;Are we checking secondary slot JR Z,CKRM80 ;No LD A,(0FFFFH) CPL ADD A,01000000B ;Prepare to select next secondary slot JR NC,CKRM55 ;Continue if more secondary slots remain CKRM80: IN A,(PPI.AR) ADD A,01000000B ;Prepare to select next slot JR NC,CKRM50 ;Continue if more primary slots remain SUBTTL - MSXIO - Slot attribute setup ; ; Check is done, select the biggest one ; LD HL,0 ADD HL,SP LD A,H OUT (PPI.AW),A ;Set primary slot register LD A,L LD (0FFFFH),A ;Set possible secondary slot register LD A,C ;Set 'slot expanded' flag ; ; Clear work area with zero ; LD BC,0C49H ;length of work area LD DE,RAMLOW+1 LD HL,RAMLOW ;beginning of work LD (HL),0 ;init first byte LDIR ;transfer it to rest of area ; ; Set EXPTBL ; LD C,A ;Get 'slot-expanded' flag LD B,4 ;Loop 4 times LD HL,EXPTBL+3 SSLTLP: RR C ;Set carry if LSB is set SBC A,A ;[Acc]=255 if expanded, 0 if not expanded AND 80H ;Affects only MSB LD (HL),A ;Set table for each slot DEC HL DJNZ SSLTLP ; ; Set SLTTBL ; IN A,(PPI.AR) ;Remember primary slot register's content LD C,A XOR A ;Read from slot #0 OUT (PPI.AW),A LD A,(0FFFFH) CPL LD L,A LD A,01000000B ;Read from slot #1 OUT (PPI.AW),A LD A,(0FFFFH) CPL LD H,A LD A,80H ;Read from slot #2 OUT (PPI.AW),A LD A,(0FFFFH) CPL LD E,A LD A,0C0H ;Read from slot #3 OUT (PPI.AW),A LD A,(0FFFFH) CPL LD D,A LD A,C ;Restore primary slot register OUT (PPI.AW),A LD (SLTTBL),HL ;Set SLTTBL EX DE,HL LD (SLTTBL+2),HL IM 1 ;IM 1 JP INIT SUBTTL - MSXIO - Control-[C] processing ISCNTC: LD A,(BASROM) ;Is BASIC text in ROM AND A RET NZ ;Yes PUSH HL LD HL,INTFLG ;Seen any interesting key DI LD A,(HL) LD (HL),0 POP HL EI AND A RET Z ;No CP 3 ;Is it ctrl-stop? JR Z,EXCABO ;Yes, execution aborted ; ; Pause until next STOP is pressed ; PUSH HL ;STOP pressed (pause) PUSH DE PUSH BC CALL CKDPC0 ;Display cursor if disabled LD HL,INTFLG ;Wait for next interesting key WATINT: DI LD A,(HL) LD (HL),0 EI ;Wait for character if SELECT pressed AND A ;Seen? JR Z,WATINT ;Not yet PUSH AF CALL CKERC0 ;Erase cursor if disabled POP AF POP BC POP DE POP HL CP 3 ;Abort? RET NZ ;No EXCABO: PUSH HL ;Save text pointer CALL KILBUF ;Cancel any input CALL CKSTTP ;Is STOP trap ON JR NC,EXABO1 ;No, accept this break LD HL,REQSTP ;Request STOP trap DI ;Since REQTRP does not change interrupt mask, CALL REQTRP ;this must be enclosed by 'DI' and 'EI' EI POP HL ;Restore text pointer RET EXABO1: ; CALL TOTEXT ;Make sure we're in text mode LD A,(EXPTBL) ;Make sure BASIC is enabled LD H,01000000B CALL ENASLT POP HL ;Restore text pointer XOR A ;Must return with carry cleared, zero set LD SP,(SAVSTK) ;LSPD PUSH BC JP STOP CKSTTP: ; ; Check for STOP trap ; ; LD A,(REQSTP) ;Is STOP trap ON RRCA RET NC ;No, accept this break LD HL,(REQSTP+1) ;Is STOP trap specified LD A,H OR L RET Z ;No, accept this break LD HL,(CURLIN) ;Are we in direct mode INC HL LD A,H OR L RET Z ;Yes, treat as break SCF ;Set flag to indicate STOP trap active RET KILBUF: ; LD HL,(PUTPNT) ;Empties ring buffer LD (GETPNT),HL RET BREAKX: ; ; Check if stop key pressed. If pressed, return with carry set. ; IN A,(PPI.CR) AND 0F0H ;Leave others unaffected OR 7 ;Select 6th row OUT (PPI.CW),A IN A,(PPI.BR) AND 10H ;STOP key is assigned to bit 4 RET NZ ;0 when pressed IN A,(PPI.CR) DEC A OUT (PPI.CW),A IN A,(PPI.BR) AND 2 RET NZ PUSH HL LD HL,(PUTPNT) ;Cancel any input LD (GETPNT),HL POP HL LD A,(OLDKEY+7) ;STOP pressed, mark as pressed to prevent AND 0EFH ; to be doubly recognized LD (OLDKEY+7),A LD A,0DH LD (REPCNT),A SCF RET SUBTTL - MSXIO - PSG Initialization INITIO: ; ; Initialize I 0 ; LD A,7 LD E,80H CALL WRTPSG ;Set Port A to input mode LD A,0FH ;Port B to output mode LD E,0CFH CALL WRTPSG LD A,0BH ;Dummy write cycle to wake up the PSG LD E,A ;envelope register CALL WRTPSG ;Any value is OK! CALL INGI AND 01000000B LD (KANAMD),A LD A,0FFH OUT (LPT.SB),A GICINI: ; ; Initialize GI sound chip, queues, and static data. ; ; Entry - Interrupts must be disabled ; Exit - All registers preserved. ; PUSH HL ;save caller's registers PUSH DE PUSH BC PUSH AF ; ; First, clear all static data ; LD HL,MUSICF LD B,71H ;=VCBC + VCBSIZ + MUSCIF XOR A MUSCLL: LD (HL),A INC HL DJNZ MUSCLL ; ; Then clear music dynamic queue ; LD DE,VOICAQ ;Address of music queue LD B,7FH ;Mask pattern, 7F = Music queue len - 1 LD HL,80H ;Queue length GICIN1: PUSH HL ;Save length of queue PUSH DE ;Save address of queue PUSH BC ;Save mask pattern PUSH AF ;Save queue ID CALL INITQ ;Initialize a queue by [Acc],[B],[DE] POP AF ADD A,8 ;write to regs 8,9,10 LD E,0 CALL WRTPSG ;0 out amplitude (turn voice off) SUB 8 ;Restore [Acc] PUSH AF ;Save queue ID LD L,0FH ;OctaveX CALL GETVC1 ;[HL] points to octave for voice [A] EX DE,HL LD HL,MUSITB ;[HL] points to default value table LD BC,6 ;EMSITB - MUSITB LDIR ;default variables for this voice POP AF ;Restore queue ID POP BC ;Restore mask POP HL ;Restore queue address POP DE ;Restore queue length ADD HL,DE ;Update queue address EX DE,HL INC A ;Next channel CP 3 JR C,GICIN1 ;Loop till done all three voices LD A,7 ;write to reg 7 mixer control LD E,0B8H ;input port A, output port B CALL WRTPSG ;disable noise, enable all 3 tones JP POPALL ;Restore environments MUSITB: ; ; table of default values for music variables ; DB 04H ;default octave DB 04H ;default note length DB 78H ;default tempo DB 88H ;default volume DB 0FFH ;default envelope period DB 00H EMSITB: ;end of music table SUBTTL - MSXIO - Utility routines for VDP INITXT: ; ; Initialize VDP for text mode (40 by 24) ; CALL DISSCR XOR A LD (SCRMOD),A LD (OLDSCR),A LD A,(LINL40) LD (LINLEN),A LD HL,(TXTNAM) LD (NAMBAS),HL LD HL,(TXTCGP) LD (CGPBAS),HL CALL CHGCLR ;Set border/foreground/background color CALL CLRTXT CALL INIPAT ;Initialize character pattern CALL SETTXT ;Actually set VDP registers JR ENASCR INIT32: ; ; Initialize VDP for text mode (graphics 1) ; CALL DISSCR LD A,1 LD (SCRMOD),A LD (OLDSCR),A LD A,(LINL32) LD (LINLEN),A LD HL,(T32NAM) LD (NAMBAS),HL LD HL,(T32CGP) LD (CGPBAS),HL LD HL,(T32PAT) LD (PATBAS),HL LD HL,(T32ATR) LD (ATRBAS),HL CALL CHGCLR ;Set border foreground background color CALL CLRTXT CALL INIPAT ;Initialize character pattern CALL ERASPR ;Clear sprites CALL SETT32 ;Actually set VDP registers ENASCR: ; ; Enable screen display ; LD A,(RG1SAV) OR 01000000B JR DISSC1 DISSCR: ; ; Disable screen display ; LD A,(RG1SAV) AND 0BFH DISSC1: LD B,A LD C,1 WRTVDP: ; ; Write data to VDP ; ; C = register # ; B = value to be set ; ; Register save area for the register is properly set ; LD A,B ;Get data to set DI OUT (VDP.CW),A LD A,C ;Get register # OR 80H OUT (VDP.CW),A EI PUSH HL LD A,B ;Remember this value 'cause this is LD B,0 ;a write-only register LD HL,RG0SAV ADD HL,BC LD (HL),A POP HL RET SETTXT: ; ; Set VDP for text mode (40 by 32) ; LD A,(RG0SAV) ;Set register #0 AND 1 LD B,A LD C,0 CALL WRTVDP LD A,(RG1SAV) ;Set register #1 AND 0E7H OR 10H LD B,A INC C CALL WRTVDP LD HL,TXTNAM LD DE,0 ;Set mask pattern JP SETSCM ;Set screen mode SETT32: ; ; Set VDP for text mode (graphics 1) ; LD A,(RG0SAV) ;Set register #0 AND 1 LD B,A LD C,0 CALL WRTVDP LD A,(RG1SAV) ;Set register #1 AND 0E7H LD B,A INC C CALL WRTVDP LD HL,T32NAM LD DE,0 ;Set mask pattern JP SETSCM ;Set screen mode INIGRP: ; ; Initialize VDP for graphics mode ; CALL DISSCR LD A,2 LD (SCRMOD),A LD HL,(GRPPAT) LD (PATBAS),HL LD HL,(GRPATR) LD (ATRBAS),HL LD HL,(GRPNAM) ;Initialize name table CALL SETWRT XOR A LD B,3 INIGR1: OUT (VDP.DRW),A INC A JR NZ,INIGR1 DJNZ INIGR1 CALL CLSHRS ;Clear pattern and color table CALL ERASPR CALL SETGRP ;Actually set VDP mode JP ENASCR SETGRP: ; ; Set VDP for graphics mode (graphics 2) ; LD A,(RG0SAV) ;Set register #0 OR 2 LD B,A LD C,0 CALL WRTVDP LD A,(RG1SAV) ;Set register #1 AND 0E7H LD B,A INC C CALL WRTVDP LD HL,GRPNAM LD DE,7F03H JR SETSCM INIMLT: ; ; Initialize VDP for multi-color mode ; CALL DISSCR LD A,3 LD (SCRMOD),A LD HL,(MLTPAT) LD (PATBAS),HL LD HL,(MLTATR) LD (ATRBAS),HL LD HL,(MLTNAM) ;Initialize name table CALL SETWRT LD DE,6 INIML1: LD C,4 INIML2: LD A,D LD B,' ' INIML3: OUT (VDP.DRW),A INC A DJNZ INIML3 DEC C JR NZ,INIML2 LD D,A DEC E JR NZ,INIML1 CALL CLSMLT ;Clear pattern table CALL ERASPR CALL SETMLT ;Actually set VDP mode JP ENASCR SETMLT: ; ; Set VDP for multicolor mode ; ; LD A,(RG0SAV) ;Set register #0 AND 1 LD B,A LD C,0 CALL WRTVDP LD A,(RG1SAV) ;Set register #1 AND 0E7H OR 8 LD B,A LD C,1 CALL WRTVDP LD HL,MLTNAM LD DE,0 ;Set mask pattern SETSCM: LD BC,SETGRP CALL SETREG ;Set name table LD B,0AH LD A,D CALL SETRG1 ;Set color table LD B,5 LD A , E CALL SETRG1 ;Set pattern table LD B,9 CALL SETREG ;Set sprite attribute table LD B,5 ;Set sprite pattern table SETREG: XOR A SETRG1: PUSH HL PUSH AF LD A,(HL) INC HL LD H,(HL) LD L,A XOR A SETRG2: ADD HL,HL ADC A,A DJNZ SETRG2 LD L,A POP AF OR L LD B,A CALL WRTVDP POP HL INC HL INC HL INC C RET CLRSPR: ; ; Clear all sprites ; ; LD A,(RG1SAV) ;Set register #1 LD B,A LD C,1 CALL WRTVDP LD HL,(PATBAS) ;Clear sprite pattern table LD BC,0800H ;Length of sprite pattern table XOR A CALL FILVRM ERASPR: LD A,(FORCLR) ;Load foreground color (default) to [E] LD E,A LD HL,(ATRBAS) LD BC,2000H ;Set number of sprite plane to [B] CLSPR2: ; default sprite name to [C] ; LD A,0D1H ;Erase code (i.e. vertical position) CALL WRTVRM ;Set vertical position INC HL INC HL LD A,C ;Load default sprite name CALL WRTVRM INC HL INC C ;Prepare for next LD A,(RG1SAV) RRCA RRCA ;16*16? JR NC,CLSPR3 ;No INC C ;Yes, C=C+4 INC C INC C CLSPR3: LD A,E ;Load default color CALL WRTVRM INC HL DJNZ CLSPR2 RET CALPAT: ; LD L,A LD H,0 ADD HL,HL ;Assume 8 byte long ADD HL,HL ADD HL,HL CALL GSPSIZ ;Check size of sprite CP 8 JR Z,GSPAD1 ;Good assumption ADD HL,HL ;32 byte long sprite ADD HL,HL GSPAD1: EX DE,HL LD HL,(PATBAS) ;Get base address of sprite pattern table ADD HL,DE ;Form destination/source address RET CALATR: ; LD L,A ;Get plane number to [L] LD H,0 ADD HL,HL ;Sprite attribute consists of 4 bytes ADD HL,HL EX DE,HL LD HL,(ATRBAS) ;Load base address ADD HL,DE ;Calculate target address RET GSPSIZ: ; ; Get sprite size ; LD A,(RG1SAV) RRCA RRCA LD A,8 ;Assume 8 byte long RET NC ;Good assumption LD A,32 ;32 byte long sprite RET LDIRMV: ; CALL SETRD EX (SP),HL EX (SP),HL LDIMV1: IN A,(VDP.DRW) LD (DE),A INC DE DEC BC LD A,C OR B JR NZ,LDIMV1 RET INIPAT: ; ; Set default character pattern ; CALL H.INIP LD HL,(CGPBAS) ;Get target address of VRAM CALL SETWRT ;Set VDP for write operation LD A,(CGPNT) ;Get slot # of character genarator table LD HL,(CGPNT+1) ;Get address of character genarator table LD BC,0800H ;Load total length PUSH AF ;Save source slot INIPT1: POP AF ;Restore source slot PUSH AF ;Save source slot PUSH BC ;Save counter DI CALL RDSLT ;Read from specified slot EI POP BC ;Restore counter OUT (VDP.DRW),A INC HL ;Bump character source pointer DEC BC LD A,C OR B JR NZ,INIPT1 POP AF ;Discard stack RET LDIRVM: ; EX DE,HL CALL SETWRT LDIVM1: LD A,(DE) OUT (VDP.DRW),A INC DE DEC BC LD A,C OR B JR NZ,LDIVM1 RET GETPAT: ; ; Get pattern corresponding to ASCII code in [A] ; ; Pattern is returned to 8 byte work area (PATWRK). Entered ; by GRPPRT (print a character to graphic screen) subroutine. ; ; All registers are completely destroyed ; LD H,0 ;Prepare for calculation LD L,A ADD HL,HL ADD HL,HL ADD HL,HL EX DE,HL LD HL,(CGPNT+1) ADD HL,DE ;[HL]:=source address LD DE,PATWRK ;Load destination address LD B,8 ;Load total length LD A,(CGPNT) ;Get slot # of character genarator table GTPAT1: PUSH AF ;Save source slot PUSH HL ;Save source address PUSH DE ;Save destination address PUSH BC ;Save counter CALL RDSLT ;Read from specified slot EI POP BC ;Restore counter POP DE ;Restore destination address POP HL ;Restore source address LD (DE),A INC DE ;Bump destination pointer INC HL ;Bump character source pointer POP AF ;Restore source slot DJNZ GTPAT1 RET CLSSUB: ; CALL CHKSCR ;Check current screen mode JR Z,CLSHRS ;Hires JR NC,CLSMLT ;Multi-color CLRTXT: ; ; Clear screen (text mode) ; LD A,(SCRMOD) AND A LD HL,(NAMBAS) ;Set address for write LD BC,03C0H ;40 * 24 JR Z,CLRTX1 LD BC,0300H ;32 * 24 CLRTX1: LD A,' ' ;Fill space character code CALL FILVRM CALL CSHOME ;Set cursor at home position LD HL,LINTTB ;Say all lines are terminated LD B,18H CLRTX2: LD (HL),B ;Load non 0 value INC HL DJNZ CLRTX2 JP FNKSB CLSHRS: ; CALL CHGBDR ;Set border color LD BC,1800H ;Initialize color PUSH BC ;Save this for future use LD HL,(GRPCOL) LD A,(BAKCLR) ;Load background color CALL FILVRM LD HL,(GRPCGP) POP BC ;Load 6144 XOR A JFLVRM: JP FILVRM CLSMLT: ; CALL CHGBDR ;Set border color LD HL,BAKCLR ;Set all pixels to background color LD A,(HL) ADD A,A ADD A,A ADD A,A ADD A,A OR (HL) LD HL,(MLTCGP) ;Set up address for write LD BC,0600H JR JFLVRM ;Clear sprites (except sprite pattern) WRTVRM: ; ; Write a byte to VRAM ; PUSH AF ;Save data to be written CALL SETWRT EX (SP),HL EX (SP),HL POP AF OUT (VDP.DRW),A RET RDVRM: ; ; Read a byte from VRAM ; CALL SETRD EX (SP),HL EX (SP),HL IN A,(VDP.DRW) RET SETWRT: ; ; Set address for write to VDP ; ; Address is passed to HL ; LD A,L DI OUT (VDP.CW),A LD A,H AND 00111111B OR 01000000B ;For write, set bit 6 high OUT (VDP.CW),A EI RET SETRD: ; ; Set address for read from VDP ; ; Address is passed to HL ; LD A,L DI OUT (VDP.CW),A LD A,H AND 00111111B OUT (VDP.CW),A EI RET CHGCLR: ; ; CHGCLR - changes foreground, background, and border color ; LD A,(SCRMOD) ;Are we in text mode DEC A JP M,CHCLTX ;Yes, change color in 40*24 text mode PUSH AF CALL CHGBDR ;Change border color for all POP AF RET NZ ;No LD A,(FORCLR) ;We're in 32*24 text mode ADD A,A ADD A,A ADD A,A ADD A,A LD HL,BAKCLR OR (HL) LD HL,(T32COL) LD BC,20H FILVRM: PUSH AF CALL SETWRT FLVRM1: POP AF OUT (VDP.DRW),A PUSH AF DEC BC LD A,C OR B JR NZ,FLVRM1 POP AF RET CHCLTX: ; LD A,(FORCLR) ADD A,A ADD A,A ADD A,A ADD A,A LD HL,BAKCLR OR (HL) LD B,A JR CHGBD1 CHGBDR: ; LD A,(BDRCLR) ;Get border color CHGBD1: LD B,A LD C,7 JP WRTVDP TOTEXT: ; ; TOTEXT - Force screen to text mode ; CALL CHKSCR ;Check current screen mode RET C ;We're in text mode LD A,(OLDSCR) CALL H.TOTE JP CHGMOD ;No, change to text mode then CLS: ; ; CLS - clears screen ; RET NZ ;Statement not ending PUSH HL ;Save text pointer CALL CLSSUB POP HL ;Restore text pointer RET CHGMOD: ; ; CHGMOD - changes mode of screen ; DEC A ;Change to what mode JP M,INITXT ;To text mode JP Z,INIT32 DEC A JP Z,INIGRP ;To hires mode JP INIMLT ;To multicolor mode SUBTTL - MSXIO - Some entry points LPTOUT: ; ; Output a character to printer ; CALL H.LPTO PUSH AF ;Save character to output CHPLP1: CALL BREAKX ;Check if aborted JR C,LPTABO CALL LPTSTT JR Z,CHPLP1 ;No POP AF ;Restore character CHPLP2: PUSH AF ;Save it again OUT (LPT.DW),A ;Send to output port XOR A ;Generate strobe OUT (LPT.SB),A DEC A OUT (LPT.SB),A POP AF ;Restore data output AND A RET LPTABO: ; XOR A ;Reset carriage position LD (LPTPOS),A LD A,0DH ;Send CR even if LPT not active CALL CHPLP2 POP AF SCF RET LPTSTT: ; CALL H.LPTS IN A,(LPT.ST) ;LSB is 0 if ready RRCA RRCA CCF SBC A,A RET ;No POSIT: ; ; Position cursor to specified position ; LD A,1BH RST 18H ;OUTCHR LD A,'Y' RST 18H LD A,L ADD A,1FH ;= ' ' - 1 RST 18H LD A,H ADD A,1FH RST 18H RET CNVCHR: ; ; Convert character code ; PUSH HL PUSH AF LD HL,GRPHED ;Preceeded by a header byte XOR A CP (HL) LD (HL),A ;Clear this since seen JR Z,CNVCH3 ;No POP AF SUB 01000000B ;Get rid of offset CP ' ' ;Valid range JR C,CNVCH2 ;Yes ADD A,01000000B ;Compensate value CNVCH1: CP A ;Set Z flag SCF ;Make sure carry is cleared CNVCH2: POP HL RET CNVCH3: ; POP AF CP 1 ;Graphic header JR NZ,CNVCH1 ;No, do not modify LD (HL),A ;Set GRPHED flag POP HL ;Carry is clear indicating one more byte is RET ;required SUBTTL - MSXIO - Output a character to CRT CHPUT: ; PUSH HL PUSH DE PUSH BC PUSH AF CALL H.CHPU CALL CHKSCR ;Are we in text mode JR NC,POPALL ;No, ignore this CALL CKERCS ;Erase old cursor if cursor enabled POP AF PUSH AF CALL CHPUT1 CALL CKDPCS ;Display new cursor if cursor enabled LD A,(CSRX) DEC A LD (TTYPOS),A POPALL: POP AF PBDHRT: POP BC POP DE POP HL RET CHPUT1: ; CALL CNVCHR ;Convert character code RET NC ;Was a graphic header, wait for next LD C,A ;Save character code in [C] JR NZ,CHPUT3 ;Converted code, send as is LD HL,ESCCNT LD A,(HL) ;Are we executing escape sequence AND A ; JP NZ,INESC ;Yes LD A,C ;Restore character CP ' ' ;Control code JR C,CNTPUT ;Yes CHPUT3: LD HL,(CSRY) CP 7FH ;Rubout JP Z,RUBOUT ;Yes CALL PUTVRM ;Convert to raw code and write to VRAM CALL RIGHT ;Advance cursor RET NZ ;All done if not wrapped to next line XOR A CALL SETTRM ;Unterminate this line LD H,1 ;Go to start of the next line LF: ; ; Line feed ; CALL DOWN ;Down cursor RET NZ ;Exit if not at bottom CALL STOCSR LD L,1 ;L:=windad top line JP DELLN0 ;Scroll up by deleting the first line CNTPUT: ; ; Following control codes are supported ; ; 7 Bell ; 8 Back space ; 9 Tab ; 10 Line feed ; 11 Cursor home ; 12 Clear screen ; 13 Carriage return ; ; 27 Enter escape sequence ; 28 Cursor right ; 29 Cursor left ; 30 Cursor up ; 31 Cursor down ; LD HL,JMPBC LD C,0CH INDJMP: INC HL INC HL AND A ;Make sure carry is cleared DEC C RET M ;Undefined function CP (HL) ;Found? INC HL JR NZ,INDJMP ;No LD C,(HL) ;Get routine address in BC INC HL ; LD B,(HL) ; LD HL,(CSRY) ;Jump to each routine with cursor pos CALL JMPBC XOR A ;Tell screen editor not to echo this character RET JMPBC: ; PUSH BC RET ; ; Function dispatch table ; CNTTBL: DB 7 ;Beep DW BEEP DB 8 ;Back space DW BS DB 9 ;Tabulation DW TAB DB 10 ;Line feed DW LF DB 11 ;Home DW CSHOME DB 12 ;Clear DW CLRTXT DB 13 ;Carriage return DW CR DB 27 ;Enter escape sequence DW ENTESC DB 28 ;Cursor right DW ADVCUR DB 29 ;Cursor left DW BS DB 30 ;Cursor up DW UP DB 31 ;Cursor down DW DOWN SUBTTL - MSXIO - Escape sequence handler ESCTBL: DB "j" ;Clear screen DW CLRTXT DB "E" ;Clear screen DW CLRTXT ; To maintain compatibility with VT52 DB "K" ;Erase to end-of-line DW EOL DB "J" ;Erase to end-of-page DW EOP DB "l" ;Erase entire line DW ELN DB "L" ;Insert a line DW ILN DB "M" ;Delete a line DW DLN DB "Y" ;Locate cursor DW LOC DB "A" ;Cursor up DW UP DB "B" ;Cursor down DW DOWN DB "C" ; Cursor right DW RIGHT DB "D" ;Cursor left DW LEFT DB "H" ;Cursor home DW CSHOME DB "x" ;Set modes DW SETMOD DB "y" ;Reset modes DW RSTMOD SETMOD: ; ; Function dispatch table ; LD A,1 DB 1 RSTMOD: LD A,2 DB 1 LOC: LD A,4 ;Say row is expected next DB 1 ;'LXI B' instruction ENTESC: LD A,0FFH ;Tell him we're in escape sequence LD (ESCCNT),A RET INESC: ; JP P,INESC1 ;Arguments expected LD (HL),0 ;Exit from escape sequence LD A,C ;Restore character LD HL,ESCTBL-2 LD C,0FH ;Number of ESC handler entries JP INDJMP INESC1: ; DEC A ;Set modes? JR Z,GOSET ;Yes DEC A ;Reset modes? JR Z,GORSET DEC A LD (HL),A ;Update ESCCNT LD A,(LINLEN) ;Assume column expected LD DE,CSRX JR Z,INESC2 ;Column expected LD (HL),3 CALL GETLEN ;Row expected DEC DE ;Point CSRY INESC2: LD B,A ;Get max limit in B LD A,C ;Restore character SUB ' ' ;0-xx CP B INC A LD (DE),A RET C ;Legal value LD A,B ;Substitute by possible largest value LD (DE),A RET GOSET: ; ; Set various modes ; LD (HL),A ;Exit from escape sequence LD A,C ;Restore character SUB '4' ;Block cursor? JR Z,STSTYL ;Yes DEC A ;Cursor off? JR Z,STCSSW ;Yes, reset cursor-enable switch RET ;Unimplemented feature GORSET: ; ; Reset various modes ; ; LD (HL),A ;Exit from escape sequence LD A,C ;Restore character SUB '4' ;Underscore cursor? JR NZ,RSET10 ;No, try next INC A STSTYL: LD (CSTYLE),A RET RSET10: ; DEC A ;Cursor on? RET NZ ;No, unimplemented feature INC A STCSSW: LD (CSRSW),A RET CKDPC0: ; ; Display cursor if disabled ; LD A,(CSRSW) AND A RET NZ JR DSPCSR CKDPCS: ; ; Display cursor if enabled ; LD A,(CSRSW) AND A RET Z DSPCSR: ; ; Display a cursor ; CALL H.DSPC CALL CHKSCR RET NC LD HL,(CSRY) ;Get current cursor position PUSH HL ;Save it for future use CALL GETVRM ;Get a raw character at cursor LD (CODSAV),A ;Remember this code LD L,A ;Then read pattern for this code LD H,0 ADD HL,HL ; [A] * 8 ADD HL,HL ADD HL,HL EX DE,HL LD HL,(CGPBAS) PUSH HL ADD HL,DE CALL GET8B LD HL,BUFEND+7 ;Make a complement of this pattern LD B,8 ;Assume full reverse cursor LD A,(CSTYLE) AND A JR Z,DSPCS1 ;Good assumption LD B,3 ;No, reverse bottom 3 lines only DSPCS1: LD A,(HL) CPL LD (HL),A DEC HL DJNZ DSPCS1 POP HL ;Assign this pattern to 255 LD BC,07F8H ADD HL,BC CALL PUT8B POP HL ;Restore cursor position LD C,0FFH ;Get code for cursor JP PUTVRM ;Set it at cursor position CKERC0: ; ; Erase cursor if disabled ; LD A,(CSRSW) AND A RET NZ JR ERACSR CKERCS: ; ; Erase a cursor if enabled ; LD A,(CSRSW) AND A RET Z ERACSR: ; ; Erase cursor ; CALL H.ERAC CALL CHKSCR RET NC LD HL,(CSRY) LD A,(CODSAV) ;Get old code LD C,A JP PUTVRM ;Restore old code ; SUBTTL - MSXIO - Cursor movements RIGHT: ; ; Cursor right ; LD A,(LINLEN) CP H ;Are we at the right-end of line? RET Z ;Yes, return with Z flag INC H ;Go to next column JR STOCSR BS: ; ; Back space ; CALL LEFT RET NZ ;Not at left-end LD A,(LINLEN) LD H,A DB 11H ;'LXI D,' instruction LEFT: ; ; Cursor left ; DEC H ;Are we at the left-end of line? DB 3EH ;'MVI A,' instruction UP: ; ; Cursor up ; DEC L ;Are we at the top of any window? RET Z ;Yes, return with Z flag JR STOCSR ADVCUR: ; ; Advance cursor ; CALL RIGHT RET NZ LD H,1 DOWN: ; ; Cursor down ; CALL GETLEN ;Get an actual bottom of screen CP L ;Are we at the bottom of screen? RET Z ;Yes, return with Z flag JR C,DOWN1 ;We're below screen bottom INC L ;Go to next line STOCSR: LD (CSRY),HL RET DOWN1: ; DEC L XOR A JR STOCSR TAB: ; ; Tabulation ; LD A,' ' CALL CHPUT1 LD A,(CSRX) DEC A AND 7 JR NZ,TAB RET CSHOME: ; ; Cursor home ; LD L,1 CR: ; ; Carriage return ; LD H,1 ;CR only, not new-line JR STOCSR ; SUBTTL - MSXIO - Line insert and delete of CRT DLN: ; ; Delete a line specified by [L] ; ; Cursor should be set at the top of line ; CALL CR DELLN0: CALL GETLEN ;Get an actual height of screen SUB L RET C ;Something is wrong JP Z,ELN ;Delete the bottom line only PUSH HL ;Save row PUSH AF ;Save counter (# of lines to be moved upward) LD C,A LD B,0 CALL GETTRM ;Get address of [LINTTB] in [DE] LD L,E LD H,D INC HL LDIR LD HL,FSTPOS DEC (HL) POP AF POP HL DELLN1: PUSH AF ;Save counter INC L CALL GET1LN ;Get 1 line specified by L DEC L CALL PUT1LN ;Put 1 line specified by L INC L POP AF ;Restore counter DEC A JR NZ,DELLN1 JP ELN ;Blank bottom line ILN: ; ; Insert a line ; ; Cursor should be set at the top of line ; CALL CR INSLN0: CALL GETLEN ;Get an actual height of screen LD H,A SUB L RET C ;Something is wrong!! JP Z,ELN LD L,H PUSH HL ;Save row to be inserted PUSH AF ;Save # of lines to be moved downward LD C,A LD B,0 CALL GETTRM LD L,E LD H,D PUSH HL ;Save pointer to [LINTTB] for the bottom line DEC HL ; Form source address LDDR POP HL LD (HL),H ;Make sure the bottom line is terminated POP AF POP HL INSLN1: PUSH AF ;Save counter DEC L CALL GET1LN INC L CALL PUT1LN DEC L POP AF ;Restore counter DEC A JR NZ,INSLN1 JR ELN ; SUBTTL - MSXIO - Character(s) erase RUBOUT: ; ; Erase previous character ; CALL BS ;Back space RET Z ;We're at the top of screen LD C,' ' ;Overstrike with a space JP PUTVRM ELN: ; ; Erase entire line ; ; Cursor should remain unchanged ; LD H,1 EOL: ; ; Erase to end-of-line ; ; Cursor should remain unchanged ; CALL TERMIN PUSH HL ;Save current position (column) CALL VADDR CALL SETWRT POP HL ;Restore current position EREOL1: LD A,' ' ;Overstrike with a space OUT (VDP.DRW),A INC H LD A,(LINLEN) CP H JR NC,EREOL1 RET EOP: ; ; Erase to end-of-page ; ; Cursor should remain unchanged ; PUSH HL ;Save current position CALL EOL ;Erase to end-of-line POP HL ;Restore current position CALL GETLEN ;Get an actual height of CRT CP L RET C ;Something is wrong RET Z ;All done LD H,1 INC L JR EOP ; SUBTTL - MSXIO - Function keys display/erase. ERAFNK: ; ; Erase function key ; CALL H.ERAF XOR A ;Say no function key is displayed CALL SETCHK RET NC ;We're not in text mode, just set flag PUSH HL ;Save possible text pointer LD HL,(CRTCNT) ;Erase last line CALL ELN POP HL ;Restore possible text pointer RET FNKSB: ; ; Display function key if enabled ; LD A,(CNSDFG) ;Now being displayed? AND A RET Z ;No DSPFNK: ; ; Display function key ; CALL H.DSPF LD A,0FFH ;Say function key is displayed CALL SETCHK RET NC ;We're not in text mode, just set flag PUSH HL ;Save possible text pointer LD A,(CSRY) LD HL,CRTCNT CP (HL) LD A,0AH ;Scroll up if we're at the bottom of screen JR NZ,NTBOTM RST 18H NTBOTM: LD A,(SFTKEY) ;Get current shift status RRCA LD HL,FNKSTR ;Assume shift not pressed LD A,1 JR C,DSPFK1 ;Good assumption LD HL,FNKSTR+80 ;Shift is being pressed XOR A DSPFK1: LD (FNKSWI),A ;Mark which part of function key is displayed LD DE,BUFEND ;Set temporary destination PUSH DE LD B,'(' ;=40 LD A,' ' DSFKCL: LD (DE),A INC DE DJNZ DSFKCL POP DE ;Restore temporary destination in [DE] LD C,5 ;Total number of keys LD A,(LINLEN) ;Calculate (LINLEN-4) / 5 SUB 4 JR C,DSPFKE ;Not enough room for function keys LD B,0FFH DSPFK4: INC B SUB 5 JR NC,DSPFK4 LD A,B AND A JR Z,DSPFKE ;No enough room DB 3EH ;Skip next byte DSPFK2: INC DE ;Put separator space PUSH BC ;Save key counter LD C,0 ;Reset # of characters actually fetched DSPFK5: LD A,(HL) ;Get from function key string INC HL ;Prepare for next fetch INC C CALL CNVCHR JR NC,DSPFK5 ;This is a graphic header, fetch more JR NZ,DSPFK8 ;Converted graphics character, store this CP ' ' ;Printable? JR C,DSPFK6 ;No, ignore this DSPFK8: LD (DE),A DSPFK6: INC DE DJNZ DSPFK5 LD A,10H SUB C LD C,A ;Skip rest ADD HL,BC POP BC ;Restore counter DEC C JR NZ,DSPFK2 DSPFKE: LD HL,(CRTCNT) ;Display at the lowest line CALL PUT1LN POP HL ;Restore possible text pointer RET ; SUBTTL - MSXIO - Low level routines SETCHK: ; ; Set CNSDFG and check current screen mode ; LD (CNSDFG),A CHKSCR: ; ; Check current screen mode ; LD A,(SCRMOD) CP 2 RET ;Return with the status GET8B: ; ; Get 8 bytes from HL ; PUSH HL LD C,8 JR GET1L1 GET1LN: ; ; Get character and attribute of position specified by H,L ; ; Character returned in C ; PUSH HL LD H,1 CALL VADDR LD A,(LINLEN) LD C,A GET1L1: LD B,0 LD DE,BUFEND ;Storage for 1 line CALL LDIRMV POP HL RET PUT8B: ; PUSH HL LD C,8 JR PUT1L1 PUT1LN: ; PUSH HL LD H,1 CALL VADDR LD A,(LINLEN) LD C,A PUT1L1: LD B,0 EX DE,HL LD HL,BUFEND CALL LDIRVM POP HL RET GETVRM: ; PUSH HL ;Save coordinate CALL VADDR ;Calculate VRAM address CALL SETRD ;Set up VDP for read EX (SP),HL EX (SP),HL IN A,(VDP.DRW) ;Get character code in C LD C,A POP HL ;Restore coordinate RET PUTVRM: ; PUSH HL CALL VADDR CALL SETWRT LD A,C OUT (VDP.DRW),A POP HL RET VADDR: ; ; Calculate buffer address out of H,L (column,row) ; ; address returned in HL ; PUSH BC LD E,H ;Get column in L LD H,0 LD D,H DEC L ADD HL,HL ADD HL,HL ADD HL,HL LD C,L LD B,H ADD HL,HL ADD HL,HL ADD HL,DE LD A,(SCRMOD) AND A LD A,(LINLEN) JR Z,VADDR1 SUB '"' JR VADDR2 VADDR1: ; ADD HL,BC SUB 41+1 VADDR2: CPL AND A RRA LD E,A ADD HL,DE EX DE,HL LD HL,(NAMBAS) ADD HL,DE DEC HL POP BC RET GETTRM: ; ; Get value of line-terminator-table and affect flags ; ; Entry: L has the line # ; Exit: DE has the address of corresponding terminator byte. ; Z flag is affected. ; PUSH HL ;Save HL LD DE,BASROM LD H,0 ADD HL,DE ;Get address of table LD A,(HL) EX DE,HL ;Move address to DE POP HL ;Restore HL AND A ;Affect flags RET TERMIN: ; DB 3EH ;Load non 0 value in Acc UNTERM: XOR A SETTRM: PUSH AF CALL GETTRM ;Get address of terminator byte in DE POP AF LD (DE),A ;Change table RET GETLEN: ; ; Get an actual height of screen ; LD A,(CNSDFG) ;0 or -1 PUSH HL LD HL,CRTCNT ADD A,(HL) POP HL RET ; SUBTTL - MSXIO - Keyboard encoding routines KEYINT: ; ; Encode keyboard ; ; Timer interrupt routine ; PUSH HL ;Save all registers PUSH DE PUSH BC PUSH AF EXX EX AF,AF' PUSH HL PUSH DE PUSH BC PUSH AF PUSH IY PUSH IX CALL H.KEYI ;To allow other interrupts than 60Hz timer IN A,(VDP.SR) ;Clear possible interrupt request AND A ;Interrupt requested by VDP? JP P,INTRET ;No, skip the rest CALL H.TIMI ;To allow timer interrupt to be ;used elsewhere. EI ;Now that it became obvious that VDP ;generated the interrupt, we re-enable ;interrupt here to allow RS232C's ;interrupt or something like that. LD (STATFL),A ;Store this new status AND ' ' ;Collision detected? LD HL,TRPTBL+33 ;Assume so CALL NZ,REQTRP ;Request trap if so ; ; Check interval trap ; LD HL,(INTCNT) ;Count down interval count DEC HL LD A,H OR L JR NZ,NTINTT ;Not yet reached 0 LD HL,TRPTBL+3*17 ;Request trap CALL REQTRP LD HL,(INTVAL) ;Load initial value NTINTT: LD (INTCNT),HL ;Update interval count ; ; Increment jiffy count ; LD HL,(JIFFY) INC HL LD (JIFFY),HL ; ; Check music queue ; LD A,(MUSICF) ;Check music flag LD C,A XOR A ;Start with queue 0 MUSINT: RR C ;C7=carry, carry=C0, [C]=[C]/2 PUSH AF ;Save queue ID PUSH BC ;Save MUSICF CALL C,ACTION POP BC POP AF INC A ;Next queue CP 3 ;All done? JR C,MUSINT ;Not yet LD HL,SCNCNT DEC (HL) ;Need to scan? JR NZ,INTRET ;No, return soon LD (HL),3 ;Time delay of first repeat ; ; Check trigger button of joy sticks ; XOR A CALL SLSTCK ;Read joystick A AND 00110000B PUSH AF LD A,1 CALL SLSTCK AND '0' RLCA RLCA POP BC OR B PUSH AF CALL GTROW8 AND 1 POP BC OR B LD C,A ;Save this LD HL,TRGFLG XOR (HL) ;Any transition? AND (HL) ;Is this transition negative LD (HL),C ;Update trigger status LD C,A RRCA ;Check space key trigger LD HL,TRPTBL+3*12 CALL C,REQTRP RL C ;Check trigger 4 LD HL,TRPTBL+3*16 CALL C,REQTRP RL C ;Check trigger 2 LD HL,TRPTBL+3*14 CALL C,REQTRP RL C ;Check trigger 3 LD HL,TRPTBL+3*15 CALL C,REQTRP RL C ;Check trigger 1 LD HL,TRPTBL+3*13 CALL C,REQTRP ; ; Scan keyboard ; XOR A ;Enable first key click LD (CLIKFL),A CALL KEYCHK ;Detect valid key transition and check buffer JR NZ,INTRET ;Some characters still remain, don't repeat LD HL,REPCNT DEC (HL) ;Need to enter repeat mode JR NZ,INTRET ;No LD (HL),1 ;Set short time repeat LD HL,OLDKEY ;Clear OLDKEY status LD DE,OLDKEY+1 LD BC,0AH LD (HL),0FFH LDIR CALL KEYCK4 ;Check if currently pressed key is valid INTRET: POP IX ;Restore all registers POP IY POP AF POP BC POP DE POP HL EX AF,AF' EXX POP AF POP BC POP DE POP HL EI RET KEYCHK: ; IN A,(PPI.CR) ;Get what is currently output to Port C AND 0F0H ;Leave higher 4 bits unaffected LD C,A LD B,0BH LD HL,NEWKEY ;Move current key status to NEWKEY KEYCK1: LD A,C OUT (PPI.CW),A ;Select row IN A,(PPI.BR) ;Get column information of selected raw LD (HL),A ;Move it INC C ;Select next raw INC HL DJNZ KEYCK1 ;Loop until all rows are sensed LD A,(ENSTOP) ;Warm start enabled? AND A JR Z,NOSTOP ;No LD A,(SFTKEY) ;Get current status of the 6th row CP 0E8H ;Check if KANA, GRAPH, CTRL and SHIFT JR NZ,NOSTOP ;are pressed simultaneously LD IX,READYR JP CALBAS NOSTOP: ; LD DE,NEWKEY ;[OLDKEY] + 11 LD B,0BH KEYCK2: DEC DE DEC HL LD A,(DE) ;Get OLDKEY status CP (HL) ;Compare with NEWKEY status JR NZ,KEYCK3 ;Changed, set long repeat interval DJNZ KEYCK2 JR KEYCK4 ;No change KEYCK3: ; LD A,0DH LD (REPCNT),A KEYCK4: LD B,0BH ;Set number of rows LD HL,OLDKEY LD DE,NEWKEY KEYCK5: LD A,(DE) ;Get current key status LD C,A XOR (HL) ;See if any bit changed AND (HL) ;See if this change is negative transition LD (HL),C ;Update old status CALL NZ,KEYANY ;Active transition, go find it INC DE INC HL DJNZ KEYCK5 CHKBUF: ; ; Check if buffer is empty or not ; LD HL,(GETPNT) ;Load GETPNT LD A,(PUTPNT) ;Load lower 8 bit of PUTPNT SUB L ;Check if same RET CHSNS: ; EI ;Make sure interrupts are enabled PUSH HL ; Save environments PUSH DE PUSH BC CALL CHKSCR ;Are we in text mode? JR NC,CHSNS1 ;No, do not flip function keys LD A,(FNKSWI) ;Get current shift status LD HL,SFTKEY ;Get current function key display XOR (HL) ;Are they different LD HL,CNSDFG ;Function key displayed at all? AND (HL) RRCA CALL C,DSPFNK ;Update display CHSNS1: CALL CHKBUF POP BC ;Restore environments POP DE POP HL RET KEYANY: ; ; [[[ SUBROUTINE 'KEYANY' ]]] ; PUSH HL ;Save environments PUSH DE PUSH BC PUSH AF ;Save pressed bit LD A,0BH SUB B ;Calculate base code ADD A,A ADD A,A ADD A,A LD C,A LD B,8 ;Set up counter for 8 bit POP AF ;Restore pressed bit KYANY1: RRA PUSH BC PUSH AF CALL C,KEYCOD ;If pressed bit, call key coder. POP AF POP BC INC C ;Try next code DJNZ KYANY1 ;Loop until all bits are checked JP PBDHRT ;Restore environments ; ; [[[ SUBROUTINE 'KEYCOD' ]] ; ; Return key-code in buffer if valid ; KYJTAB: DB 10 DW KYNUM ;0..9 DB 22 DW KYCOD1 DB 48 DW KYALP ;A..Z DB 51 DW KYEASY DB 52 DW KYLOCK ;Capital lock DB 53 DW KYKLOK ;Kana lock DB 58 DW KYFUNC ;Function key DB 60 DW KYEASY DB 61 DW KYSTOP ;Stop key DB 65 DW KYEASY DB 66 DW KYCLS ;CLS/HOME key DB 255 DW KYEASY ; NMSFTB: DB 255 DB "'" DB 34 ;Double quote DB "#$%&'()" ; ALPJMP: DW PUTCHR ;CTRL+shift DW PUTCHR ;CTRL DW KEYSFT ; SHIFT DW KEYNOM ; ; KYC1TB: DW KY1SFC-10 ;CTRL+SHIFT DW KY1CNT-10 ;CTRL DW KY1SFT-10 ; SHIFT DW KY1NOM-10 ; KY1NOM: DB "-^\@[;:],./" DB 255 KY1SFT: DB "=~`{+*}" DB 00111100B ;Less than sign DB 00111110B ;Greater than sign DB "?_" KY1CNT: DB "-" DB "^"-"@" DB "\"-"@" DB "@"-"@" DB "["-"@" DB ";:" DB "]"-"@" DB ",./" DB 255 KY1SFC: DB "=" DB "^"-"@" DB "\"-"@" DB "@"-"@" DB "["-"@" DB "+*" DB "]"-"@" DB 00111100B ;Less than sign DB 00111110B ;Greater than sign DB "?" DB "_"-"@" ; EASYTB: DB 0 ;Shift (48) DB 0 ;Control (49) DB 0 ;Graph (50) DB 0 ;Cap lock (51) DB 0 ;Kana lock (52) DB 0 ;F1 (53) DB 0 ;F2 (54) DB 0 ;F3 (55) DB 0 ;F4 (56) DB 0 ;F5 (57) DB 27 ;Escape (58) DB 9 ;Tab (59) DB 0 ;Stop (60) DB 8 ;Back space (61) DB "X"-"@" ;Select (62) DB 13 ;Enter (63) DB 32 ;Space (64) DB 12 ;Clear (65) DB "R"-"@" ;Insert (66) DB 127 ;Rubout (67) DB 29 ;Left (68) DB 30 ;Up (69) DB 31 ;Down (70) DB 28 ;Right (71) ; ; For additional key matrix ; DB "A"-"@" ; (72) DB "D"-"@" ; (73) DB "O"-"@" ; (74) DB "P"-"@" ; (75) DB "Q"-"@" ; (76) DB "R"-"@" ; (77) DB "S"-"@" ; (78) DB "T"-"@" ; (79) DB 0 ; (80) DB 0 ; (81) DB 0 ; (82) DB 0 ; (83) DB 0 ; (84) DB 0 ; (85) DB 0 ; (86) DB 0 ; (87) ; KEYCOD: ; ; [[[ SUBROUTINE 'KEYCOD' ]]] ; ; Return key-code in buffer if valid ; LD A,C ;Get raw code CP 0FFH ;Just for fail safe RET Z LD HL,KYJTAB CALL H.KEYC CP 48 ;Possibly a KANA or graphic character JR NC,KYCLAS ;No LD A,(SFTKEY) ;Get shift key status RRCA ;Control pressed? RRCA JR NC,KYCLA0 ;Yes, this supersedes everything RRCA ;How about graphic shift JP NC,KYGRAP ;Yes, this has the 2nd priority LD A,(KANAST) ;KANA lock active AND A JP NZ,KYKANA ;Yes KYCLA0: LD A,C KYCLAS: CP (HL) ;Compare range INC HL LD E,(HL) ;Get jump address in [DE] INC HL LD D,(HL) INC HL PUSH DE ;Assume matched RET C ;Good assumption POP DE ;Discard stack JR KYCLAS ;Check next possibility KYNUM: ; ADD A,'0' ;Assume no shift LD B,A ;Save code LD A,(SFTKEY) ;Check shift status RRCA LD A,B ;Restore code JR C,JPUTCH ;Good assumption LD B,0 LD HL,NMSFTB ADD HL,BC ;This must not be 'DADF' LD A,(HL) ;Get code for shift-number CP 0FFH ;Shift '0'? RET Z ;Yes, ignore this JPUTCH: JP PUTCHR ;Put this in buffer KYALP: ; LD A,(SFTKEY) AND 3 ADD A,A LD E,A LD D,0 LD HL,ALPJMP ADD HL,DE LD A,(HL) ;Get jump address INC HL LD H,(HL) LD L,A LD A,C ;Get code SUB 15H ;Make it a control character (1 - 26) JP (HL) KEYSFT: ; ADD A,' ' KEYNOM: LD B,A ;Save code LD A,(CAPST) CPL AND 00100000B ;Bit 5 is on if CAP lock not active XOR B ADD A,01000000B JR JPUTCH KYCOD1: ; LD HL,KYC1TB LD A,(SFTKEY) AND 3 ;Extract shift and control status ADD A,A LD E,A LD D,0 ADD HL,DE LD A,(HL) INC HL LD H,(HL) LD L,A LD E,C ADD HL,DE LD A,(HL) CP 0FFH ;Should generate some code? JP NZ,PUTCHR ;Yes RET ;No code should be generated KYFUNC: ; ; Function keys ; LD A,(SFTKEY) ;Is shift pressed? RRCA JR C,KYFNC1 ;No LD A,C ADD A,5 LD C,A KYFNC1: LD E,C ;[DE] is (56..65) LD D,0 LD HL,FNKFLG-53 ;Check if this function key is an event device ADD HL,DE LD A,(HL) AND A JR NZ,FNKINT ;Request trap if not in direct mode KYFNC2: EX DE,HL ADD HL,HL ADD HL,HL ADD HL,HL ADD HL,HL LD DE,FNKSTR-53*16 ADD HL,DE ;Get function key string address EX DE,HL ;Move address to DE KYFNC3: LD A,(DE) ;Get from function key string AND A ;End of string RET Z ;Yes CALL PUTCHR ;Put this character in buffer INC DE ;Check next character JR KYFNC3 FNKINT: ; LD HL,(CURLIN) ;Are we in direct mode (CURLIN=65535) INC HL LD A,H OR L JR Z,KYFNC2 ;Yes, treat as normal function key LD HL,TRPTBL-53*3 ADD HL,DE ADD HL,DE ADD HL,DE ; REQTRP: ; ; Request trap (called to request trap for event devices) ; ; ; Since REQTRP is mostly called from within an interrupt routine, ; don't touch the interrupt mask through DI or EI. ; LD A,(HL) AND 1 ;Trap on? RET Z ;TRAP NOT ON LD A,(HL) OR 4 ;Trap request CP (HL) RET Z ;No change LD (HL),A XOR 5 ;Trap on + Trap request RET NZ LD A,(ONGSBF) INC A LD (ONGSBF),A RET ; KYCLS: LD A,(SFTKEY) ;Set carry if shift not pressed RRCA LD A,0CH ;Load code for CLS SBC A,0 ;Change to HOME if shift not pressed JR PUTCHR KYEASY: ; ; Easily converted keys ; CALL H.KYEA ;For CCP (Cut, copy, paste) editor rom LD E,A ;These character are simply taken from table LD D,0 LD HL,EASYTB-48 ADD HL,DE LD A,(HL) AND A ;Should this key generate some code RET Z ;No JR PUTCHR ;Yes KYKLOK: ; ; Kana lock key ; LD HL,KANAST LD A,(HL) CPL LD (HL),A LD A,0FH OUT (PSG.LW),A IN A,(PSG.DR) AND 7FH LD B,A LD A,(HL) CPL AND 80H OR B OUT (PSG.DW),A NOKEY: RET KYLOCK: ; ; Capital lock key ; LD HL,CAPST LD A,(HL) ;Toggle capital status CPL LD (HL),A ;Update capital status CPL CHGCAP: AND A LD A,0CH ;Assume 'turn off' JR Z,CGCAP1 ;Good assumption INC A ;Change to 'turn on' CGCAP1: OUT (PPI.CM),A RET KYSTOP: ; ; STOP key ; LD A,(SFTKEY) RRCA ;Move CTRL status to carry RRCA LD A,3 ;Assume CTRL pressed also JR NC,KYSTP1 ;Good assumption INC A ;CTRL not pressed, just treat as pause KYSTP1: LD (INTFLG),A JR C,GENCLK ;Only generate click if pause PUTCHR: ; ; Put one character in key buffer. ; LD HL,(PUTPNT) ;Load PUTPNT in [HL] LD (HL),A ;Save the character to buffer CALL UPDATE ;Increment PUTPNT LD A,(GETPNT) ;Load lower 8bit of GETPNT CP L ;Compare it with new PUTPNT RET Z ;If same skip next step LD (PUTPNT),HL ;Save HL in PUTPNT GENCLK: LD A,(CLIKSW) ;Key click enabled? AND A RET Z ;No LD A,(CLIKFL) ;Already generated? AND A RET NZ ;Yes, don't click any more LD A,0FH LD (CLIKFL),A ;Set flag to disable more clicks OUT (PPI.CM),A LD A,0AH CLICKW: DEC A JR NZ,CLICKW CHGSND: AND A LD A,0EH ;Assume 'turn off' JR Z,CGSND1 ;Good assumption INC A ;Change to 'turn on' CGSND1: OUT (PPI.CM),A RET KYKANA: ; ; KANA key pressed while KANA lock is active ; LD A,(KANAMD) ;JIS or AIUEO? AND A ;Affect Z flag LD A,(SFTKEY) ;Check shift key RRCA ;Affect Carry flag JR Z,KAIUEO ;AIUEO order LD HL,KANJNO JR C,KYKAN1 LD HL,KANJSF JR KYKAN1 KAIUEO: ; LD HL,KANANO ;Assume shift not pressed JR C,KYKAN1 ;Good assumption LD HL,KANASF KYKAN1: LD B,0 ADD HL,BC LD BC,PUTCHR ;Push jump address PUSH BC LD A,(CAPST) ;Capital lock (katakana) active? AND A LD A,(HL) RET NZ ;active CP 165+1 ;Special characters? RET C ;Yes, no conversion necessary CP 0B0H RET Z CP 0DEH RET NC SUB ' ' ;Assume first half CP 191-32+1 ;Really first half RET C ;Good assumption ADD A,32+32 ;Compensate RET KANANO: ; Kana table (AIUEO order, un-shifted ; DB 0C9H,0B1H,0B2H,0B3H,0B4H,0B5H,005H DB 0C6H,0C7H,0C8H,0D7H,0D8H,0D9H,0DAH DB 0DBH,0D3H,0DEH,0DFH,0D6H,0DCH,0A6H DB 0DDH,0BBH,0C4H,0C2H,0BDH,0B8H,0BEH DB 0BFH,0CFH,0CCH,0D0H,0D1H,0D2H,0D5H DB 0D4H,0CDH,0CEH,0B6H,0B9H,0BCH,0BAH DB 0CBH,0C3H,0B7H,0C1H,0CAH,0C0H KANASF: ; Shifted ; DB 0C9H,0A7H,0A8H,0A9H,0AAH,0ABH,005H DB 0C6H,0C7H,0C8H,0D7H,0D8H,0D9H,0DAH DB 0A2H,0D3H,0B0H,0A3H,0AEH,0A4H,0A1H DB 0A5H,0BBH,0C4H,0AFH,0BDH,0B8H,0BEH DB 0BFH,0CFH,0CCH,0D0H,0D1H,0D2H,0ADH DB 0ACH,0CDH,0CEH,0B6H,0B9H,0BCH,0BAH DB 0CBH,0C3H,0B7H,0C1H,0CAH,0C0H KANJNO: ; Kana table JIS order, un-shifted ; DB 0DCH,0C7H,0CCH,0B1H,0B3H,0B4H,0B5H DB 0D4H,0D5H,0D6H,0CEH,0CDH,0B0H,0DEH DB 0DFH,0DAH,0B9H,0D1H,0C8H,0D9H,0D2H DB 0DBH,0C1H,0BAH,0BFH,0BCH,0B2H,0CAH DB 0B7H,0B8H,0C6H,0CFH,0C9H,0D8H,0D3H DB 0D0H,0D7H,0BEH,0C0H,0BDH,0C4H,0B6H DB 0C5H,0CBH,0C3H,0BBH,0DDH,0C2H KANJSF: ; Shifted ; DB 0A6H,0C7H,0CCH,0A7H,0A9H,0AAH,0ABH DB 0ACH,0ADH,0AEH,0CEH,0CDH,0B0H,0DEH DB 0A2H,0DAH,0B9H,0A3H,0A4H,0A1H,0A5H DB 0DBH,0C1H,0BAH,0BFH,0BCH,0A8H,0CAH DB 0B7H,0B8H,0C6H,0CFH,0C9H,0D8H,0D3H DB 0D0H,0D7H,0BEH,0C0H,0BDH,0C4H,0B6H DB 0C5H,0CBH,0C3H,0BBH,0DDH,0AFH ; KYGRAP: ; ; Graphic characters ; LD B,0 LD HL,GRPTAB ADD HL,BC LD A,(HL) ;Get from graphic key table AND A ;Should generate some code RET Z ;No CP 80H ;1 byte code? PUSH AF LD A,1 ;Assume not CALL C,PUTCHR ;Was 2 byte code, put header byte POP AF JP PUTCHR ; GRPTAB: DB 4FH,47H,41H,42H,43H,44H,45H DB 46H,4DH,4EH,57H,00H,49H,00H DB 84H,82H,81H,85H,5FH,5DH,80H DB 83H,00H,5BH,5AH,54H,58H,55H DB 53H,4AH,56H,00H,00H,5EH,4BH DB 00H,00H,50H,00H,52H,4CH,59H DB 00H,51H,00H,5CH,48H,00H ; UPDATE: ; ; Update pointer ; INC HL LD A,L CP 18H ;Check buffer boundary RET NZ LD HL,KEYBUF RET CHGET: ; ; Get one character from keyboard ; PUSH HL PUSH DE PUSH BC CALL H.CHGE CALL CHSNS ;Character already there? JR NZ,CHGET2 ;Yes, do not touch cursor CALL CKDPC0 ;Display cursor if disabled CHGET1: CALL CHSNS ;Any character in buffer? JR Z,CHGET1 ;No, wait CALL CKERC0 ;Erase cursor if disabled CHGET2: LD HL,INTFLG LD A,(HL) CP 4 ;Code for pause? JR NZ,CHGET3 ;No LD (HL),0 ;Clear this CHGET3: LD HL,(GETPNT) LD C,(HL) ;Save pressed key CALL UPDATE ;Update [GETPNT] LD (GETPNT),HL ;Set new [GETPNT] LD A,C ;Pass result to Acc JP PBDHRT CKCNTC: ; ; Check ctl-C ; PUSH HL LD HL,0 ;To disable CONTinuing CALL ISCNTC POP HL RET ; SUBTTL - MSXIO - Music routines WRTPSG: ; ; Write data to specified register of GI sound chip ; Entry - (E)=data,(A)=register number ; Exit - All regs preserved ; ; GI Reg# - usage ; ; 0 voice A fine tune ; 1 voice A coarse tune ; 2 voice B fine tune ; 3 voice B coarse tune ; 4 voice C fine tune ; 5 voice C coarse tune ; 7 B7,B6 = Reg 14,15 Input Output flags ; B5,B4,B3 = voice C,B,A noise enable (0=enabled) ; B2,B1,B0 = voice C,B,A tone enable (0=enabled) ; 8 voice A volume (0..15 = volume, 16=use envelope) ; 9 voice B volume (0..15 = volume, 16=use envelope) ; 10 voice C volume (0..15 = volume, 16=use envelope) ; 11-12 envelope period ; 13 envelope shape (0..15) ; 14 joystick 1 port ; 15 joystick 2 port ; DI OUT (PSG.LW),A ;LATCH ADDRESS PUSH AF LD A,E OUT (PSG.DW),A ;OUTPUT DATA EI POP AF RET INGI: ; ; Input data from PAD ; LD A,PSG.PA RDPSG: OUT (PSG.LW),A IN A,(PSG.DR) RET BEEP: ; ; BEEP causes a 'bell' sound ; ; Exit - all registers are destroyed ; XOR A ;[A]=fine tune register for voice A LD E,01010101B ;data to be written on R0 CALL WRTPSG LD E,A ;0 to coarse tune register INC A CALL WRTPSG ;R1 coarse LD E,10111110B ;enable voice [A] tone LD A,7 ;[A]=voice enable register CALL WRTPSG ;R7 LD E,A ;set volume to 7 INC A ;[A]=voice A volume register CALL WRTPSG ;R8 LD BC,07D0H CALL CSDLY1 JP GICINI ;reset GI sound chip CSDLY1: ; ; Delay by [BC] ; DEC BC EX (SP),HL EX (SP),HL LD A,B OR C JR NZ,CSDLY1 RET ; ACTION: ; ; Get action information from specified music queue. Perform ; action with synchronization. Called by interrupt routine ; in time. ; ; - Action information - ; ; ITEM 1 - 2 BYTES ; ; + Number of bytes that follow this item ; | ; NNNTTTTTTTTTTTTT ; | ; +Period of time ; ; ITEM 2, 3, 4 - FROM 1 TO 5 BYTES ; ; IF HO 2 BITS = 0 then this is the HO byte of the tone period. ; IF HO 2 BITS = 2 then this is just a volume control byte. ; IF BIT 4 IS ON, envelope control is in effect, and bits ; 0-3 give shape number of envelope. ; IF BIT 4 IS OFF, BITS 0-3 give amplitude number. ; IF HO 2 BITS = 3 THEN this byte will be followed by a 2 byte ; envelope period, HO first. ; ; ENTRY - (A)=Channel count number (0..2) ; LD B,A ;Save channel number CALL GETVCP ;Get pointer into vcb of channel DEC HL LD D,(HL) DEC HL LD E,(HL) ;[DE]=countdown timer for voice DEC DE ;Decrement timer LD (HL),E ;Put it back lo first INC HL LD (HL),D LD A,D OR E RET NZ ;No action if not zero LD A,B ;Voice 0 uses queue 0 LD (QUEUEN),A ;Set queue ID for further 'CALL XGETQ' CALL XGETQ CP 0FFH JR Z,VOICOF ;branch if EOF marker LD D,A ;SAVE IN [D] AND 0E0H ;Get number of following items RLCA RLCA RLCA LD C,A ;Save in [C] LD A,D AND 1FH ;GET LO 5 BITS OF [D] LD (HL),A ;Set MSB of new countdown CALL XGETQ ;Get LSB of new countdown DEC HL LD (HL),A ;Set it INC C MORACT: DEC C ;Done all items? RET Z ;Yes CALL XGETQ ;Get next item from queue LD D,A ;Save this to [D] AND 0C0H ;Get HO 2 bits JR NZ,XVOL ;Execute volume action ; ; Set tone ; CALL XGETQ ;Get low byte for tone LD E,A LD A,B ;Get back voice number RLCA ;X 2 CALL WRTPSG ;Output fine tune register INC A ;Point to coarse tune register LD E,D ;Restore saved value CALL WRTPSG ;Output coarse tune reg DEC C ;Decrement since we took 2 bytes from queue JR MORACT XVOL: ; LD H,A ;save it in [H] AND 80H ;BIT 7 SET? JR Z,XEPER ; ; Set volume ; LD E,D ;[A] has junk in ho which shouldn't matter LD A,B ;Get back voice number ADD A,8 ;Regs 8,9,10 CALL WRTPSG ;Output amplitude reg LD A,E AND 10H ;Check envelope generate bit LD A,0DH ;Reg 13 for shape CALL NZ,WRTPSG ;Set envelope shape if enabled XEPER: ; ; Set envelope period ; LD A,H AND 01000000B ;See if set envelope period JR Z,MORACT ;No CALL XGETQ ;Get ho byte of envelope period LD D,A CALL XGETQ ;Get low byte of envelope period LD E,A LD A,0BH ;Register 11 for fine tune CALL WRTPSG INC A ;Point to coarse tune LD E,D CALL WRTPSG DEC C DEC C JR MORACT VOICOF: ; ; Comes here when an EOF mark has been found for a specified ; channel ; LD A,B ADD A,8 ;Set appropriate reg # LD E,0 CALL WRTPSG ;Turn off volume INC B LD HL,MUSICF XOR A SCF RSTFL1: RLA DJNZ RSTFL1 AND (HL) ;Get that bit XOR (HL) ;Turn it off LD (HL),A STRTMS: ; ; STRTMS starts the background music task if: ; 1) - it is currently idle (MUSICF=0) and ; 2) - there is work queued for it (PLYCNT .GTR. 0) ; LD A, (MUSICF) OR A RET NZ ;return if background task is active LD HL,PLYCNT LD A,(HL) OR A RET Z ;return if nothing for it to do DEC (HL) ;l less thing for it to do LD HL,1 LD (VCBA),HL ;start it playing now LD (VCBB),HL LD (VCBC),HL LD A,0111B ;Trigger! LD (MUSICF),A RET XGETQ: ; LD A,(QUEUEN) ;Get queue ID PUSH HL PUSH DE PUSH BC CALL GETQ ;Get a byte from a specified queue JP PBDHRT ;pop H, D, B and return ; SUBTTL - MSXIO - Joystick and Paddle interface GTSTCK: ; DEC A JP M,KYSTCK ;STICK(0) - read cursor keys CALL SLSTCK ;Read joystick LD HL,STKTBL STICK1: AND 0FH LD E,A LD D,0 ADD HL,DE LD A,(HL) RET KYSTCK: ; CALL GTROW8 ;Read keyboard RRCA ;Move cursor status to lower four bits RRCA RRCA RRCA LD HL,KSTKTB JR STICK1 SLSTCK: ; ; Select proper joystick and read from it ; LD B,A LD A,PSG.PB DI CALL RDPSG ;Read what is currently output to port B DJNZ SLSTC1 ;STICK(1) AND 0DFH ;Make sure P8 is low state OR 4CH ;Select joystick 2, enable P6,P7 JR SLSTC2 SLSTC1: ; AND 0AFH ;Select joystick 1, make sure P8 is low state OR 3 ;Enable P6,P7 SLSTC2: OUT (PSG.DW),A CALL INGI ;Read status of joystick port EI RET GTROW8: ; ; Get keyboard's 8th row, bit assignments are as follows. ; ; RDULxxxS ; |||| | ; |||| +- space ; |||+----- left ; ||+------ up ; |+------- down ; +-------- right ; DI IN A,(PPI.CR) AND 0F0H ADD A,8 OUT (PPI.CW),A IN A,(PPI.BR) EI RET ; STKTBL: DB 0 ;RLBF DB 5 ;RLB DB 1 ;RL F DB 0 ;RL DB 3 ;R BF DB 4 ;R B DB 2 ;R F DB 3 ;R DB 7 ; LBF DB 6 ; LB DB 8 ; L F DB 7 ; L DB 0 ; BF DB 5 ; B DB 1 ; F DB 0 ; ; KSTKTB: DB 0 ;RBFL, DB 3 ;RBF DB 5 ;RB L DB 4 ;RB DB 1 ;R FL DB 2 ;R F DB 0 ;R L DB 3 ;R DB 7 ; BFL DB 0 ; BF DB 6 ; B L DB 5 ; B DB 8 ; FL DB 1 ; F DB 7 ; L DB 0 ; ; GTTRIG: ; DEC A JP M,KEYTRG ;STRIG(0), use keyboard PUSH AF AND 1 CALL SLSTCK ;Read joystick POP BC DEC B DEC B LD B,10H ;Prepare mask pattern for trigger A JP M,TRIG1 LD B,' ' ;Prepare mask pattern for trigger B TRIG1: AND B ;Extract trigger status TRIG2: SUB 1 ;Return 255 if [Acc]=0, 0 if non-0 SBC A,A RET KEYTRG: ; CALL GTROW8 ;Read keyboard AND 1 ;Extract space status JR TRIG2 GTPDL: ; ; Get value of paddle ; ; Input parameters (passed via [Acc]) ; ; 1 - Paddle A connected to joystick port 1 ; 2 - Paddle A connected to joystick port 2 ; 3 - Paddle B connected to joystick port 1 ; 4 - Paddle B connected to joystick port 2 ; 5 - Paddle C connected to joystick port 1 ; 6 - Paddle C connected to joystick port 2 ; 7 - Paddle D connected to joystick port 1 ; 8 - Paddle D connected to joystick port 2 ; 9 - Paddle E connected to joystick port 1 ; 10 - Paddle E connected to joystick port 2 ; 11 - Paddle F connected to joystick port 1 ; 12 - Paddle F connected to joystick port 2 ; INC A ;Force parameter 2 based AND A RRA PUSH AF ;Save port # (carry reset if port 1) LD B,A XOR A SCF PDL1: RLA ;Form mask pattern DJNZ PDL1 LD B,A ;Set mask pattern POP AF LD C,10H ;Assume port 1 LD DE,03AFH JR NC,PDLP1 ;Good assumption LD C,' ' LD DE,4C9FH PDLP1: LD A,PSG.PB DI CALL RDPSG ;Get current port B content AND E OR D OR C OUT (PSG.DW),A ;Set trigger high XOR C OUT (PSG.DW),A ;Set trigger low again LD A,0EH OUT (PSG.LW),A LD C,0 ;Initialize counter PDL2: IN A,(PSG.DR) AND B ;End of pulse? JR Z,PDL3 ;Yes INC C ;Bump counter JP NZ,PDL2 ;No overflow yet DEC C ;Make it 255 PDL3: EI LD A,C ;Return counted value RET GTPAD: ; ; Read touch pad (NEC PC-6051 compatible) ; ; Input parameter (passed via [Acc] ) ; ; 0 - sense touch pad status --- ; 1 - return X coordinate |for touch pad connected ; 2 - return Y coordinate |to joystick port 1 ; 3 - return switch status ----- ; ; 4 - sense touch pad status --- ; 5 - return X coordinate |for touch pad connected ; 6 - return Y coordinate |to joystick port 2 ; 7 - return switch status ----- ; ; Result is returned via [Acc]. As for status, 255 is returned ; if true, 0 if false. ; CP 4 ;Read pad connected to port 1 LD DE,0CECH ;Assume so JR C,GTPDP1 ;Good assumption LD DE,03D3H ;Connected to port 2 SUB 4 GTPDP1: DEC A ;Argument=0? JP M,GTPAD0 ;If so, read pad and return status DEC A LD A,(PADX) ;Assume PAD(1) - X coordinate RET M ;Good assumption LD A,(PADY) ;Return Y coordinate RET Z GTPAD0: PUSH AF ;Save status (minus if PAD(0) specified) EX DE,HL ;[L]=bits that are not to be modified LD (RUNFLG),HL ;[H]=bits that are to be added SBC A,A CPL AND 01000000B LD C,A ;0 if port 1 specified, 100 octal if port 2 LD A,PSG.PB DI ;disable interrupt till done CALL RDPSG AND 0BFH OR C OUT (PSG.DW),A ;Select proper port POP AF JP M,TRYAGN ;PAD(0) specified CALL INGI EI AND 8 SUB 1 SBC A,A RET TRYAGN: ; LD C,0 ; CALL REDPAD ;inz CALL REDPAD ;sense Panel input and select X JR C,PADX1 ;branch if no input CALL REDCOD ;read first coordinate JR C,PADX1 ;branch if input released PUSH DE ;save for comparison CALL REDCOD ;read another input POP BC ;restore previos coord JR C,PADX1 ;branch if input released LD A,B SUB D ;[A]=ABS(X0-X1) JR NC,NONEG1 CPL INC A NONEG1: CP 5 ;less than 5? JR NC,TRYAGN ;no, try again LD A,C SUB E ;[A]=ABS(Y0-Y1) JR NC,NONEG2 CPL INC A NONEG2: CP 5 ;less than 5 JR NC,TRYAGN ;no, try again LD A,D LD (PADX),A ;update coordinate [X] LD A,E LD (PADY),A ;update coordinate [Y] PADX1: EI ;finally enable interrupt LD A,H ;get SENSE input value SUB 1 SBC A,A RET ;return value REDCOD: ; ; Read X,Y coordinate into [D,E] ; LD C,0AH ;change to channel to [Y] when done CALL REDPAD ;read [X] RET C ;return if input released LD D,L PUSH DE LD C,0 ;change to [X] after read CALL REDPAD ;read [Y] POP DE LD E,L ;store Y read out XOR A ;clear carry LD H,A ;force input is OK RET REDPAD: ; ; Read touch panel input into [L] ; Carry set if input released during read ; CALL CHKEOC ;make sure AD completed LD B,8 ;input 8 bits LD D,C ;input channel# after done REDLOP: RES 0,D ;serial clock(SCK)=1 RES 2,D CALL OUTGI CALL INGI ;read PAD LD H,A ;save SENSE status RRA RRA RRA RL L ;bit 2 to LSB of [L] SET 0,D ;SCK=0 SET 2,D CALL OUTGI DJNZ REDLOP SET 4,D SET 5,D CALL OUTGI ;initiate another AD LD A,H ;LSB=SENSE status RRA ;SENSE status to carry RET ;OK if no carry CHKEOC: ; ; Check and wait for EOC ; LD A,00110101B OR C LD D,A CALL OUTGI ;reset CS EOCCHK: CALL INGI AND 2 ;test EOC JR Z,EOCCHK RES 4,D ;set CS and return RES 5,D OUTGI: ; ; Output [D] to PAD ; ; PUSH HL PUSH DE LD HL,(RUNFLG) ;Also known as [PADWRK] LD A,L CPL AND D LD D,A LD A,PSG.PB OUT (PSG.LW),A IN A,(PSG.DR) AND L OR D OR H OUT (PSG.DW),A POP DE POP HL RET ; SUBTTL - MSXIO - Misc. routines for MSXIO STMOTR: AND A JP M,FLPMOT ;Flip motor switch STMOT1: JR NZ,MOTRON LD A,00001001B ;Stop motor DB 0C2H ;Skip next 2 bytes ('JNZ' instruction) MOTRON: LD A,8 OUT (PPI.CM),A RET FLPMOT: ; IN A,(PPI.CR) AND 10H JR STMOT1 NMI: ; ; NMI handler ; CALL H.NMI RETN ;RETN ; INIFNK: ; ; Initialize function key strings ; LD BC,0A0H LD DE,FNKSTR LD HL,FNKDEF LDIR RET ; FNKDEF: DB "color " DS 10 DB "auto " DS 11 DB "goto " DS 11 DB "list " DS 11 DB "run" DB 13 DS 12 DB "color 15,4,7" DB 13 DS 3 DB "cload" DB 34 DS 10 DB "cont" DB 13 DS 11 DB "list." DB 13,30,30 DS 8 DB 12 DB "run" DB 13 DS 11 ; RDVDP: ; IN A,(VDP.SR) RET RSLREG: ; IN A,(PPI.AR) RET WSLREG: ; OUT (PPI.AW),A RET SNSMAT: ; LD C,A DI IN A,(PPI.CR) ;Get what is currently output to Port C AND 0F0H ;Leave higher 4 bits unaffected ADD A,C OUT (PPI.CW),A ;Select row IN A,(PPI.BR) ;Get column information of selected row EI RET ISFLIO: ; ; Check if we're doing device I 0 ; CALL H.ISFL PUSH HL ;Save [H,L] LD HL,(PTRFIL) ;Get file pointer LD A,L OR H ;No zero? POP HL ;Restore [H,L] RET DCOMPR: ; ; COMPAR compares [H,L] with [D,E] unsigned ; ; [H,L] less than [D,E] set carry ; [H,L] = [D,E] set zero ; ; [A] is the only register used ; LD A,H SUB D RET NZ LD A,L SUB E RET GETVCP: ; ; Entry - [A] = voice id (0..2) ; Exit - [HL] = pointer to QLENGX for voice (within static var buf) ; [A] = 0. All other registers preserved. ; LD L,2 JR GETVC1 GETVC2: ; ; Entry - [L] = desired displacement into voice buffer ; Exit - [HL] = pointer to desired variable for voice VOICEN ; [A] = 0. All other registers preserved. ; LD A,(VOICEN) GETVC1: ; ; Entry - [A] = voice id (0..2) ; [L] = desired displacement into voice buffer ; Exit - [HL] = pointer to desired variable for voice VOICEN ; [A] = 0. All other registers preserved. ; PUSH DE LD DE,VCBA LD H,0 ADD HL,DE OR A JR Z,GETVCX LD DE,25H ;VCB size GETVCL: ADD HL,DE DEC A JR NZ,GETVCL GETVCX: POP DE RET PHYDIO: ; CALL H.PHYD RET FORMAT: ; CALL H.FORM RET SUBTTL - QUEUTL - Queue utility routines ; Copyright (C) 1980 by Microsoft Corporation ; Written by Marc Wilson ; ; This utility provides for multiple queues with the following ; capabilities: ; ; Queues of varying length - 1,3,7,15,31,63,127,255 ; ; Each queue can be any of the possible lengths ; The queues can be initialized at any time and be ; located anywhere a single pointer (QUEUES) pray ides ; the address of the queue table. ; ; The queue table has all information for each queue, ; 6 bytes per queue. A single non-zero character can ; be pushed back on top of the queue. ; ; The entry for each queue is as follows: ; +0 PUT OFFSET ; +1 GET OFFSET ; +2 BACK CHARACTER ; +3 QUEUE LENGTH ; +4,+5 QUEUE ADDRESS ; ; The utility assumes that the queue table is ; valid for all queue numbers passed to the routines ; ;ROUTINES: ; All routines assume that [A] equals the queue number, ; [QUEUES] contains the address of the queue table. ; Other requirements follow. ; GETQ - Returns current top of queue in [A], ; zero flag set if queue empty ; PUTQ - Puts byte in [E] reg on end of queue, ; zero set if queue is full ; ;NOTE: ; The routines are designed to be reentrant, however ; there are some restrictions for cases involving a ; single queue (in any case operating on different ; queues is alright). The firs t restriction is that ; the same routine cannot be reentered. The second ; is that INITQ and POPQ do not allow PUTQ, ; GETQ or BCKQ to be entered. ; ; LFTQ - Returns unused number of bytes in queue in [A] reg ; INITQ - Initialize queue to empty state, ; B reg=length, (DE)=ADDR ; *** All routines destroy the registers *** ; SUBTTL - QUEUTL - Queue routines PUTQ: ; ; Put data on queue ; ; CALL GETPTR ;Get queue pointers LD A,B INC A ;Bump PUT INC HL AND (HL) ;Wrap around CP C RET Z ;QUEUE full PUSH HL DEC HL DEC HL DEC HL EX (SP),HL ;Save place to put new pointer INC HL LD C,A ;Pointer in C LD A,(HL) INC HL LD H,(HL) LD L,A ;(HL) = QUEUE address LD B,0 ADD HL,BC ;(HL) = Address to put char LD (HL),E POP HL LD (HL),C ;set new pointer RET GETQ: ; ; Get data from QUEUE ; CALL GETPTR ;Get queue pointers LD (HL),0 ;zero back character JR NZ,GETBAK LD A,C CP B RET Z ;QUEUE empty! INC HL INC A ;Bump GET offset AND (HL) ;wrap around DEC HL DEC HL PUSH HL ;Save place to store pointer INC HL INC HL INC HL LD C,A ;offset in C LD A,(HL) INC HL LD H,(HL) LD L,A ;[HL] = QUEUE address LD B,0 ADD HL,BC LD A,(HL) ;get char from QUEUE POP HL LD (HL),C OR A RET NZ INC A LD A,0 RET GETBAK: LD C,A LD B,0 LD HL,QUEBAK-1 ADD HL,BC LD A,(HL) RET INITQ: ; ; INITQ - Initialize QUEUE ; PUSH BC ;Save queue length CALL QSTART ;Get addr of start of QUEUE table entry LD (HL),B ;Clear PUT offset INC HL LD (HL),B ;Clear GET offset INC HL LD (HL),B ;Clear back character INC HL POP AF LD (HL),A ;Set QUEUE length INC HL LD (HL),E INC HL LD (HL),D ;Set QUEUE address RET LFTQ: ; ; LFTQ - Returns number of bytes remaining in QUEUE ; CALL GETPTR ;Get QUEUE ptrs LD A,B INC A INC HL AND (HL) LD B,A ;B=PUT PTR+1 LD A,C SUB B ;subtract PUT from GET AND (HL) ;make it positive UNSIGNED INTEGER LD L,A LD H,0 RET GETPTR: ; ; QUEUE general routines ; CALL QSTART ;Get start of QUEUE TABLE entry LD B,(HL) ;B = PUT OFFSET INC HL LD C,(HL) ;C = GET OFFSET INC HL LD A,(HL) ;A = BACK CHARACTER OR A RET ; QSTART: RLCA ;*2 LD B,A RLCA ;*4 ADD A,B ;*6 LD C,A LD B,0 LD HL,(QUEUES) ADD HL,BC RET SUBTTL - MSXGRP - Graphic driver (Print a character on GRP screen) GRPPRT: ; ; Print a character on the graphic screen ; PUSH HL PUSH DE PUSH BC PUSH AF CALL CNVCHR ;Convert code JR NC,JPPPAL ;Graphic header byte, return soon JR NZ,GPRT05 ;Converted graphic code CP 0DH ;CR? JR Z,GRPCR ;Do not ignore CR even on graphic screen CP ' ' ;Control character? JR C,JPPPAL ;Yes, ignore this GPRT05: CALL GETPAT ;Get character pattern in PATWRK LD A,(FORCLR) ;Set color of character LD (ATRBYT),A LD HL,(GRPACY) EX DE,HL ;Current Y coordinate in [DE] LD BC,(GRPACX) ;Current X coordinate in [BC] CALL SCALXY ;Do the scaling JR NC,JPPPAL ;Do not print if already out of screen CALL MAPXYC ;Map to CLOC and CMASK LD DE,PATWRK LD C,8 ;Row counter GPRT10: LD B,8 ;Column counter CALL FETCHC ;Get current CLOC and CMASK PUSH HL ;Save these PUSH AF LD A,(DE) ;Get pattern for a row GPRT20: ADD A,A ;Check each bit PUSH AF CALL C,SETC ;Set it if 1 CALL TRIGHT ;Move 1 pixel right POP HL ;Assume out of screen JR C,GPRT30 ;Good assumption, skip the rest PUSH HL POP AF DJNZ GPRT20 ;Loop till done all columns GPRT30: POP AF ;Restore CLOC and CMASK POP HL CALL STOREC ;Set these CALL TDOWNC ;Move 1 pixel down JR C,GPRT40 ;Out of screen, skip rest and return INC DE ;Point to next row DEC C JR NZ,GPRT10 ;Loop till done all rows GPRT40: CALL CHKMOD ;Check current screen mode LD A,(GRPACX) JR Z,GPRT50 ;We're in high-resolution mode ADD A,' ' JR C,GRPCR ;We're going out of screen JR GPRT60 GPRT50: ; ADD A,8 JR C,GRPCR GPRT60: LD (GRPACX),A ;Update cursor position JPPPAL: JP POPALL GRPCR: ; XOR A ;Reset X position LD (GRPACX),A CALL CHKMOD LD A,(GRPACY) JR Z,GPRT70 ADD A,4*8 DB 1 GPRT70: ADD A,8 CP 0C0H JR C,GPRT80 XOR A ;Reset Y position also GPRT80: LD (GRPACY),A JR JPPPAL SUBTTL - MSXGRP - (Routines for general graphics) SCALXY: ; ; SCALXY - Clips X,Y to max values in physical size and flags out ; of range values. ; ; ENTRY [BC] = X (0 ... max X), [DE] = Y (0 ... max Y) ; EXIT [BC] = X clipped, [DE] = Y clipped ; CARRY is reset if one of the value was out of bound ; PUSH HL ;save [HL] PUSH BC ;save [BC] - X coordinate LD B,1 ;no-error flag EX DE,HL ;Y coordinate to [HL] LD A,H ;Is Y coordinate negative? ADD A,A JR NC,YPOSTV ;No, positive LD HL,0 ;Substitute by 0 is negative JR YNEGTV ;And set out of bound flag YPOSTV: ; LD DE,0C0H ;Maximum Y+1 RST 20H ;Test [1-1L] with [DE] JR C,SCLYOK ;if carry, not out of bound EX DE,HL ;[HL] = 192 DEC HL ;Y = 191 ,maximum Y coordinate YNEGTV: LD B,0 ;set out of bound flag SCLYOK: EX (SP),HL ;save Y and get X to [HL] LD A,H ;Is X coordinate negative? ADD A,A JR NC,XPOSTV ;No, positive LD HL,0 ;Substitute by 0 if negative JR XNEGTV ;And set out of bound flag XPOSTV: ; LD DE,0100H ;max X +1 RST 20H ;Test [HL] with [DE] JR C,SCLXOK EX DE,HL ;[HL] = 256 DEC HL ;[HL] = 255 - max X coordinate XNEGTV: LD B,0 ;error flag SCLXOK: POP DE ;restore [DE] = Y CALL CHKMOD JR Z,HRSSCL ;We're in high-resolution mode SRL L ;Divide both X and Y by 4 because we're SRL L ;in multi-color mode SRL E SRL E HRSSCL: LD A,B RRCA ;set carry if no error LD B,H ;[BC] = X LD C,L POP HL ;restore [HL] RET CHKMOD: ; ; Check current screen mode ; LD A,(SCRMOD) SUB 2 ;In what mode are we now? RET ;Return with the condition flag MAPXYC: ; ; MAPXYC - Maps X,Y coordinates to "C" (address, mask) ; ; Entry: [BC] = X, [DE] = Y ; ; Exit: CLOC = [HL] -- Video Ram address ; CMASK = [A] -- Bit Mask ; ; [ High-resolution mode ] ; ; X coord - XXXXXXXX ( 8 bits, max=255) ; 76543210 ; ; Y coord - YYYYYYYY ( 8 bits, max=191) ; 76543210 ; ; CLOC = YYYYYXXXXXYYY ; 7654376543210 ; XXX ; 210 ;---------------------------------------- ; CMASK = 10000000 000 ; 01000000 001 ; 00100000 010 ; 00010000 011 ; 00001000 100 ; 00000100 101 ; 00000010 110 ; 00000001 111 ; ; [ Multi-color mode ] ; ; X coord - XXXXXX ( 6 bits, max=63 ) ; 543210 ; ; Y coord - YYYYYY ( 6 bits, max=47 ) ; 543210 ; ; CLOC = YYYXXXXXYYY ; 54354321210 ; ; CMASK = 11110000 if X0=0 (even) ; CMASK = 00001111 if X0=1 (odd) ; ; Note: The boundary check has already been done by a call ; to SCALXY, so no range checking is needed. ; PUSH BC ;Save X CALL CHKMOD ;Check current screen mode JR NZ,MMPXYC ;Multi-color mode LD D,C ;Save X to D also LD A,C AND 7 LD C,A LD HL,TWOPWR ;Table of power of two ADD HL,BC LD A,(HL) ;read bit mask CMASK LD (CMASK),A LD A,E ;Get Y coordinate RRCA RRCA RRCA AND 00011111B LD B,A LD A,D ;Get X coordinate AND 11111000B LD C,A LD A,E ;Get Y coordinate AND 00000111B OR C LD C,A LD HL,(GRPCGP) ADD HL,BC LD (CLOC),HL ;Set pattern generator address POP BC RET TWOPWR: ; ; Table of power of two ; DB 80H,40H,20H,10H DB 08H,04H,02H,01H ; MMPXYC: ; ; Map XY for multi-color mode ; LD A,C ;Get X position RRCA ;Even or odd? LD A,11110000B ;Assume even JR NC,MMPXY1 ;Good assumption LD A,00001111B ;Odd MMPXY1: LD (CMASK),A ;Set up mask pattern LD A,C ADD A,A ADD A,A AND 11111000B LD C,A ;Get lower byte LD A,E AND 0111B OR C LD C,A LD A,E RRCA RRCA RRCA AND 0111B LD B,A ;Get higher byte LD HL,(MLTCGP) ;Load start address of pattern table ADD HL,BC LD (CLOC),HL POP BC RET FETCHC: ; ; FETCHC - Reads the value of the graphics accumulater ; ; Exit: [HL] = CLOC, [A] = CMASK ; LD A,(CMASK) LD HL,(CLOC) RET STOREC: ; ; STOREC - Sets the graphics accumulater ; ; Entry: [HL] = CLOC, [A] = CMASK ; LD (CMASK),A LD (CLOC),HL RET READC: ; ; READC - Get the attribute of the current graphics accumulater ; position ; PUSH BC PUSH HL CALL FETCHC ;Get CLOC and CMASK LD B,A ;Save CMASK CALL CHKMOD ;Check current screen mode JR NZ,MREADC ;Multi-color mode CALL RDVRM ;Read VDP's VRAM (pattern) AND B ;Extract specified pixel PUSH AF ;Save whether the pixel is on or off LD BC,GRPDIF ADD HL,BC CALL RDVRM ;Read VDP's VRAM (color) LD B,A ;Save this to B POP AF ;Restore condition LD A,B ;Restore color JR Z,READC1 ;Specified dot is off, return ;background color READC0: RRCA ;Specified dot is on, return foreground color RRCA RRCA RRCA READC1: AND 0FH ;Make it a legal value POP HL POP BC RET MREADC: ; CALL RDVRM ;Read VRAM INC B ;Check if specified pixel is even or odd DEC B JP P,READC1 ;Odd, return lower nibble JR READC0 ;Even, return upper nibble SETATR: ; ; SETATR - Sets the attribute (color, reverse, etc..) to be ; used in future actions. ; ; Entry - [A] = Attribute ; Exit - carry set if illegal value ; CP 16 ;Must be less than 16 CCF RET C LD (ATRBYT),A RET SETC: ; ; SETC - Sets the point indicated by the graphics accumulater ; to ATTRBYT ; ; All registers except AF must be preserved. ; PUSH HL PUSH BC CALL CHKMOD ;Check current screen mode CALL FETCHC JR NZ,MSETC ;Multi-color mode PUSH DE CALL PATWRT POP DE POP BC POP HL RET MSETC: ; ; Set a pixel in multi-color mode ; LD B,A ;Save CMASK in [B] CALL RDVRM ;Read VRAM LD C,A LD A,B CPL ;Leave another unaffected AND C LD C,A LD A,(ATRBYT) ;Get specified color INC B ;Check if even or odd DEC B JP P,MSETC1 ;Odd ADD A,A ADD A,A ADD A,A ADD A,A MSETC1: OR C ;Form new color CALL WRTVRM ;Write new pattern POP BC POP HL RET SUBTTL - MSXGRP - (Graphic cursor movements) ; ; UPC, DOWNC, RIGHTC, LEFTC ; ; These are the C relative movement routines. They ; adjust the current graphics accumulater in the indicated ; direction without checking boundary conditions. ; ;----------------------------------------------------- ; TRIGHT: ; ; TRIGHT - move 1 pixel right ; Return carry set if already on border ; PUSH HL CALL CHKMOD JP NZ,MTRGT CALL FETCHC ;Get CLOC,CMASK RRCA ;Move 1 pixel right JR NC,HRZMV1 ;Within byte, just change CMASK LD A,L ;Get low byte of CLOC AND 0F8H CP 0F8H ;On right edge? LD A,80H ;Assume not JR NZ,RGHTC1 ;Goot assumption JP ONBRD1 ;On border, set carry and return RIGHTC: ; ; RIGHTC - move 1 pixel right ; PUSH HL CALL CHKMOD JP NZ,MRGTC CALL FETCHC RRCA ;move right 1 pixel JR NC,HRZMV1 ;within byte, just change CMASK RGHTC1: PUSH DE LD DE,8 ;Load offset to new position JR HRZMOV ;Change CLOC also TLEFT: ; ; TLEFT - move 1 pixel left ; Return carry set if already on border ; PUSH HL CALL CHKMOD JP NZ,MTLFT CALL FETCHC ;Get CLOC and CMASK RLCA ;Move 1 pixel left JR NC,HRZMV1 ;Within byte boundary, just change CMASK LD A,L ;Check if we're on left edge AND 0F8H LD A,1 ;Assume not JR NZ,LEFTC1 ;Good assumption JR ONBRD1 ;We're on border, set carry and return LEFTC: ; ; LEFTC - move 1 pixel left ; PUSH HL CALL CHKMOD JP NZ,MLFTC CALL FETCHC RLCA ;move left 1 pixel JR NC,HRZMV1 ;within byte boundary, just change CMASK LEFTC1: PUSH DE LD DE,0FFF8H ;Load offset to new position HRZMOV: ADD HL,DE ;Add offset to new position LD (CLOC),HL ;Update pattern address POP DE HRZMV1: LD (CMASK),A ;Update CMASK AND A ;Clear carry POP HL RET TDOWNC: ; ; TDOWNC - move 1 pixel down. ; ; Return carry set if already on screen border. ; PUSH HL PUSH DE LD HL,(CLOC) CALL CHKMOD JP NZ,MTDNC PUSH HL LD HL,(GRPCGP) LD DE,1700H ADD HL,DE EX DE,HL POP HL RST 20H ;Test [HL] with [DE] ;Looks like on border? JR C,DWNC10 ;No LD A,L ;Possibly on border INC A AND 7 ;Really? JR NZ,DWNC10 ;No JR ONBRDR ;Yes, set carry and return DOWNC: ; ; DOWNC - move 1 pixel down ; PUSH HL PUSH DE LD HL,(CLOC) CALL CHKMOD JP NZ,MDNC DWNC10: INC HL ;move down 1 pixel LD A,L ;Prepare for boundary check LD DE,0F8H ;Load possible offset to new location JR VRTMOV ;Check TUPC: ; ; TUPC - move 1 pixel up. ; Return carry set if already on screen border. ; PUSH HL PUSH DE LD HL,(CLOC) CALL CHKMOD JP NZ,MTUPC PUSH HL LD HL,(GRPCGP) LD DE,0100H ADD HL,DE EX DE,HL POP HL RST 20H ;Test [HL] with [DE] ;Looks like on border? JR NC,UPC10 ;No LD A,L ;Possibly on border AND 7 ;Really? JR NZ,UPC10 ;No ONBRDR: POP DE ONBRD1: SCF ;Set carry indicating we're on border POP HL RET UPC: ; ; UPC - move 1 pixel up ; PUSH HL PUSH DE LD HL,(CLOC) ;get current position CALL CHKMOD JP NZ,MUPC UPC10: LD A,L ;Prepare for boundary check DEC HL ;move up 1 pixel LD DE,0FF08H ;Load possible offset to new location VRTMOV: AND 7 ;Crossed boundary? JR NZ,VRTMV1 ;No, it's okay ADD HL,DE ;Get new location VRTMV1: LD (CLOC),HL ;Update pattern address AND A ;Clear carry POP DE POP HL RET MTRGT: ; ; Graphics cursor movement in multi-color mode ; [ Horizontal movements ] ; CALL FETCHC AND A LD A,0FH ;Assume CMASK is even JP M,MHZMV1 ;Within byte, just change CMASK LD A,L AND 0F8H CP 0F8H ;On right edge? JR NZ,MRGTC1 ;No, move to next pixel JR ONBRD1 ;We're on right edge, set carry and return MRGTC: ; CALL FETCHC AND A LD A,0FH ;Assume CMASK is even JP M,MHZMV1 ;Good assumption MRGTC1: PUSH DE LD DE,8 ;Next pixel is 8 byte far ;from the current position LD A,0F0H JR MHCMOV MTLFT: ; CALL FETCHC AND A LD A,0F0H ;Assume CMASK is odd JP P,MHZMV1 ;Good assumption, just change CMASK LD A,L AND 0F8H ;On left edge? JR NZ,MLFTC1 ;No JR ONBRD1 ;We're on left edge, set carry and return MLFTC: ; CALL FETCHC AND A LD A,0F0H ;Assume CMASK is odd JP P,MHZMV1 ;Good assumption, just change CMASK MLFTC1: PUSH DE LD DE,0FFF8H LD A,0FH MHCMOV: ADD HL,DE LD (CLOC),HL POP DE MHZMV1: LD (CMASK),A AND A ;Clear carry POP HL RET MTDNC: ; ; [ Vertical movements ] ; PUSH HL LD HL,(MLTCGP) LD DE,0500H ADD HL,DE POP HL RST 20H ;Possibly on border? JR C,MDNC ;No LD A,L ;Check if least 3 bits are all 1's INC A AND 7 JR NZ,MDNC ;No SCF ;We are at the bottom border, ;set carry and return POP DE POP HL RET MDNC: ; INC HL ;Move down 1 byte LD A,L LD DE,0F8H ;Load possible offset to next block JR MVTMOV ;Check MTUPC: ; PUSH HL LD HL,(MLTCGP) LD DE,0100H ;Possibly on border? ADD HL,DE POP HL RST 20H ;Test [HL] with [DE] JR NC,MUPC ;No LD A,L ;Check if we're top of a block AND 7 JR NZ,MUPC ;No SCF ;We're on top border, set carry and return POP DE POP HL RET MUPC: ; LD A,L DEC HL ;Move up 1 byte LD DE,0FF08H ;Load possible offset to next block MVTMOV: AND 7 ;Wrapped to next block? JR NZ,MVTMV1 ;No ADD HL,DE ;Yes, add up offset to next block MVTMV1: LD (CLOC),HL AND A ;Clear carry POP DE POP HL RET SUBTTL -MSXGRP- (Box fill and Misc.) NSETCX: ; ; NSETCX - Performs SETC, RIGHTC [HL] times ; ; In fact, SETC and RIGHTC are never called to increase speed, ; and for the reason described below. ; ; Since only 2 colors can be displayed in a byte, some special ; handling is required when a full-byte is set when writing left ; or right extras. In this case, we can completely ignore the ; background color for that byte, allowing 2 colors displayed ; in a byte. ; ; All registers may be destroyed. ; CALL CHKMOD JP NZ,MNSTCX ;Multi-color mode PUSH HL ;Save count CALL FETCHC ;Get CLOC and CMASK EX (SP),HL ;Reset count, save CLOC ADD A,A ;Beginig at leftmost position? JR C,NSTC20 ;Yes, no extra dots at the left PUSH AF ;Save mask pattern*2 LD BC,0FFFFH RRCA NSTC10: ADD HL,BC ;Decrement pixel count JR NC,NSTCSP ;The whole dots are within a byte RRCA JR NC,NSTC10 POP AF ;Restore mask pattern*2 DEC A ;Form left-extra pattern EX (SP),HL ;Reget CLOC, save count PUSH HL ;Save CLOC CALL PATWRT ;Write to VRAM (pattern and color) POP HL ;Restore CLOC LD DE,8 ;Load an offset to next byte ADD HL,DE ;Update pattern address EX (SP),HL ;Reget count, save CLOC NSTC20: LD A,L ;Get low byte of count AND 7 ;[A]=count mod 8 LD C,A ;save count after byte boundary LD A,H RRCA LD A,L RRA RRCA RRCA ;[HL]=[HL]/8 AND 00111111B POP HL ;Reget CLOC LD B,A ;[B]=counter JR Z,NSTC40 ;No dots in this part NSTC30: XOR A ;Make specified color a background color CALL WRTVRM ;Write to VRAM (pattern) LD DE,GRPDIF ADD HL,DE ;Calculate address of color table LD A,(ATRBYT) ;Get specified color CALL WRTVRM ;Write to VRAM (color) LD DE,GRPDIF+8 ;Load an offset to next byte ADD HL,DE ;Bump CLOC DJNZ NSTC30 ;Loop until done NSTC40: DEC C ;dot count in char boundary RET M ;No dots in right extra PUSH HL ;Save CLOC LD HL,RGTEXT ;Load address for 'right-extra' pattern table ADD HL,BC LD A,(HL) ;Get pattern JR NSTC50 RGTEXT: ; DB 80H,0C0H,0E0H,0F0H DB 0F8H,0FCH,0FEH NSTCSP: ; ADD A,A ;Get mask pattern for the right (11111100) DEC A CPL LD B,A ;Save it POP AF ;Get mask pattern for the left (00011111) DEC A AND B ;Make a pattern to write (00011100) NSTC50: POP HL ;Restore CLOC ex. PATWRT: ; ; PATWRT - Write a pattern to high-resolution screen ; ; Entry: A - Pattern to be written ; HL - Address of pattern table ; ATRBYT - Color of this pattern ; LD B,A ;Save pattern to be added CALL RDVRM ;Read VRAM (pattern) LD C,A ;Save current pattern LD DE,GRPDIF ADD HL,DE ;Form address of color table CALL RDVRM ;Read from VRAM (color) PUSH AF AND 0FH ;Extract background color LD E,A ;Save background color POP AF ;Restore foreground and background color SUB E LD D,A ;Set foreground color in the upper 4 bit ;[B] has the specified pattern, ;[C] has the current pattern, ;[D] has the current foreground color ; shifted left 4 times, ;[E] has the current background color, ;[HL] has the address of color table. LD A,(ATRBYT) ;Get specified color CP E ;Same with current background? JR Z,SAMEBG ;Yes ADD A,A ADD A,A ADD A,A ADD A,A CP D ;Same with current foreground? JR Z,SAMEFG ;Yes PUSH AF ;Save new foreground color LD A,B OR C CP 0FFH ;All pixels are going to be set? JR Z,PATWR1 ;Yes, Spock will use a new repair technique ;logically... PUSH HL ;Save address of color table PUSH DE ;Save current background color CALL SAMEFG ;Write to VRAM (pattern) POP DE ;Restore current background in [E] POP HL ;Restore color table address POP AF ;Restore new foreground color in upper ;4 bits of [Acc] OR E ;Form new foreground and background color JR JMPWRT ;Write to color table SAMEBG: ; LD A,B CPL AND C DB 11H ;Skip next 2 bytes (LXI D) SAMEFG: LD A,B OR C WTPTAB: LD DE,GRPDIF ADD HL,DE JR JMPWRT ;Write to pattern table PATWR1: ; POP AF ;Discard new foreground color LD A,B ;Reget specified pattern CPL ;Forget current background color, 'cause PUSH HL ;there's no background, we display PUSH DE ;new pattern as background color. CALL WTPTAB ;Write to pattern table POP DE POP HL LD A,(ATRBYT) ;Get new color (this will be the ;background color) OR D ;Add current foreground color JMPWRT: JP WRTVRM ;Write to VRAM (color) MNSTCX: ; ; NSETCX for multicolor screen ; PUSH HL ;Save counter CALL SETC ;Set pixel CALL RIGHTC ;Move to right POP HL ;Restore counter DEC L JR NZ,MNSTCX RET GTASPC: ; ; GTASPC - load aspect ratio for CIRCLE ; LD HL,(ASCPCT1) EX DE,HL LD HL,(ASCPCT2) RET SUBTTL -MSXGRP - (Routines for paint) PNTINI: ; ; PNTINI - Initialize border color ; PUSH AF ;Save specified color CALL CHKMOD ;In what mode are we now? JR Z,PNTHRS ;High-resolution mode POP AF CP 10H ;Legal value? CCF ;Carry means illegal JR PNTIRT PNTHRS: ; POP AF ;Discard specified color LD A,(ATRBYT) ;Always ignore specified border AND A ;Always legal PNTIRT: LD (BRDATR),A ;Set border color RET ;Return with the condition SCANR: ; ; SCANR - scan pixels to right ; Maximum number of pixels to test is passed in [DE]. ; LD HL,0 ;Initialize PNTCNT LD C,L ;Initialize PNTDFL CALL CHKMOD ;Check current screen mode JR NZ,MSCANR ;Multi-color mode ; ; Scan to right in high-resolution mode ; [B] set to 0 is need to suspend painting, 1 otherwise. ; ; Workl = Temporary storage for 'suspend painting' ; Work2 = Save area for pixel count to draw right ; Work3 = Save area for 'pixel changed' flag ; LD A,B LD (RUNFLG),A ;Remember to suspend or not XOR A ;Clear 'pixel changed' flag LD (WORK3),A LD A,(BRDATR) LD B,A ;Set border color to [B] for comparison SCANR1: CALL READC ;Read current color CP B ;Still on border? JR NZ,SCANR2 ;No, start painting DEC DE ;All pixels tested? LD A,D OR E RET Z ;Yes CALL TRIGHT ;Advance to right, and check if out of screen JR NC,SCANR1 ;Not yet out of screen, continue LD DE,0 ;All pixels has border attribute on RET ;this row, let BRDCNT be 0, and return SCANR2: ; ; A pixel with non-border attribute is found. Start painting ; CALL CHKCHG ;Check if pixel changed PUSH DE ;Save BRDCNT CALL FETCHC ;Get current CLOC, CMASK LD (CSAVEA),HL ;Set first non-border pixel encountered LD (CSAVEM),A LD DE,0 ;Initialize # of painted pixels (PNTCNT) SCANR3: INC DE ;Update PNTCNT CALL TRIGHT ;Move 1 pixel right JR C,SCANR4 ;Out of screen CALL READC ;Read color of current pixel CP B ;Reached border? JR Z,SCANR4 ;Yes CALL CHKCHG ;Check if pixel changed JR SCANR3 ;Keep on scaning SCANR4: ; PUSH DE ;Save PNTCNT CALL FETCHC ;Since NSETCX does not update 'C', these value PUSH HL ; must be saved PUSH AF LD HL,(CSAVEA) ;Set where to start painting LD A,(CSAVEM) CALL STOREC ;Set CLOC and CMASK EX DE,HL ;Set length of line to [HL] (PNTCNT) LD (WORK2),HL LD A,(WORK1) ;Same as [RUNFLG] AND A CALL NZ,NSETCX ;Draw [HL] pixels to the right if not suspend POP AF ;Restore 'last-examined-pixel' information POP HL CALL STOREC POP HL ;Restore PNTCNT POP DE ;Restore BRDCNT JP SCANL4 MSCANR: ; ; Scan to right in multi-color mode ; CALL MTSBRD ;Is it border color? JR NC,MSCNR1 ;No, start painting DEC DE ;All pixels tested? LD A,D OR E RET Z ;Yes CALL TRIGHT ;Advance to right, and check if out of screen JR NC,MSCANR ;Not yet out of screen, continue LD DE,0 ;Out of screen, let BRDCNT be 0, and return RET MSCNR1: ; CALL FETCHC ;Get CLOC,CMASK LD (CSAVEA),HL ;Save VRAM address LD (CSAVEM),A ;Save mask pattern LD HL,0 ;Initialize PNTCNT MSCNR2: INC HL ;Increment PNTCNT CALL TRIGHT ;Advance to right, and check if out of screen RET C ;Going out of screen CALL MTSBRD ;Reached border color? JR NC,MSCNR2 ;Not yet, continue RET SCANL: ; ; SCANL - Scan pixels to left ; LD HL,0 ;Initialize PNTCNT LD C,L ;Initialize PNTDFL CALL CHKMOD ;Check current screen mode JR NZ,MSCANL ;Multi-color mode ; ; Scan to left in high-resolution mode ; XOR A ;Clear 'pixel changed' flag LD (WORK3),A LD A,(BRDATR) LD B,A ;Set border color to [B] for comparison SCANL1: CALL TLEFT ;Advance to left, and check if out of screen JR C,SCANL3 ;On left edge CALL READC ;Read color of target pixel CP B ;Reached border? JR Z,SCANL2 ;Yes CALL CHKCHG ;Check if pixel changed INC HL ;Update PNTCNT JR SCANL1 SCANL2: ; CALL RIGHTC ;'C' must specify 'last pixel painted' SCANL3: PUSH HL ;Save PNTCNT LD DE,(WORK2) ;Load suspended pixels which remain ADD HL,DE ;to the right CALL NSETCX ;Draw [HL] pixel from current 'C' POP HL ;Restore PNTCNT SCANL4: LD A,(WORK3) ;Non 0 if pixels changed attribute LD C,A RET CHKCHG: ; PUSH HL LD HL,ATRBYT ;Get specified paint attribute CP (HL) ;Same? POP HL RET Z ;Yes , no change of attribute INC A ;Load non 0 to [Acc] LD (WORK3),A ;Remember this temporarily RET MSCANL: ; ; Scan to left in multi-color mode ; CALL TLEFT ;Advance to left, and check if out of screen RET C ;going out of screen CALL MTSBRD ;Reached border color? JP C,RIGHTC ;Yes, adjust CLOC, CMASK and return INC HL ;Increment PNTCNT JR MSCANL ;Continue MTSBRD: ; ; Test border subroutine for multi-color mode ; CALL READC ;Get the color of target pixel LD B,A LD A,(BRDATR) ;Load specified border color SUB B ;Reached border? SCF ;Assume so RET Z ;Yes, return with carry flag set LD A,(ATRBYT) ;Is current pixel same as ATRBYT? CP B RET Z ;Yes, no changes made. ;Return with carry reset CALL SETC ;Set this pixel to ATRBYT LD C,1 ;Set 'pixel-changed' flag AND A ;Tell caller that we plot a dot RET SUBTTL -CASET- Cassette drivers stuff ; Cassette read/write stuff ; ; Following driver assumes that T cycle is 279.365 nS ; ; Variables referenced ; PPI.CM To write to cassette ; PSG.DR To read from casette ; BREAKX Routine to check for [STOP] key pressed ; TAPOFF: ; PUSH BC PUSH AF LD BC,0 CTWOF1: DEC BC LD A,B ;Test BC OR C JR NZ,CTWOF1 POP AF POP BC TAPIOF: PUSH AF LD A,00001001B ;Stop motor OUT (PPI.CM),A POP AF EI RET TAPOON: ; ; Write out header, if [A]=0 then write short header ; otherwise write long header ( 5sec) ; OR A ;set flag for length of header PUSH AF ;save flag LD A,8 ;Motor on OUT (PPI.CM),A LD HL,0 MOTRWT: DEC HL LD A,H OR L JR NZ,MOTRWT ;wait till motor starts POP AF ;get back header length flag LD A,(HEADER) ;get length of header JR Z,SYNCW1 ;short header ADD A,A ADD A,A SYNCW1: LD B,A LD C,0 ;set up counter DI ;Don't disturb during writing to cassette SYNLP1: CALL BIT1OT ;Write enough marks CALL RETRET ;compensate overhead DEC BC LD A,B OR C JR NZ,SYNLP1 ;loop till counter exhausts JP BREAKX ;check control-stop and return TAPOUT: DATAW: ; ; Output a byte ; LD HL,(LOW) ;get time constants for space PUSH AF LD A,L SUB 0EH ;compensate loss time since last stop bit LD L,A CALL BITOUT ;output start bit POP AF LD B,8 ;Initialize counter DATAWL: RRCA ;next bit to carry CALL C,BIT1 ;output mark if the bit is 1 CALL NC,BIT0 ;Output space DJNZ DATAWL ;Loop until 8 bits sent CALL BIT1 ;Output stop bit CALL BIT1 JP BREAKX ;Check if break pressed and return BIT0: ; ; Output a bit to cassette ; ; Absolute jumps are used to improve accuracy ; LD HL,(LOW) ;Output 0 (space) (17 T) CALL BITOUT ; (18 T) RETRET: RET ; (11 T) BIT1: ; CALL BIT1OT ; (18 T) EX (SP),HL ; (20 T) EX (SP),HL ;compensate overhead (20 T) NOP ;(Total 60 state) ( 5 T) NOP ; ( 5 T) NOP ; ( 5 T) NOP ; ( 5 T) CALL BIT1OT ;To compensate time (18 T) RET ;Don't change this (11 T) BIT1OT: ; ; output a single cycle ; ; Total number of states =16 x [L] + 16 x [H] + 71 ; =4.47uS x [L] + 4.47uS x [H] + 19.8usec ; LD HL,(HIGH) ; (17 T) BITOUT: PUSH AF ; (12 T) ; KEEPL: DEC L ;Keep low level ( 5 T) JP NZ,KEEPL ; (11 T) LD A,0BH ; ( 8 T) OUT (PPI.CM),A ;Output high level (11 T) KEEPH: DEC H ;keep high level ( 5 T) JP NZ,KEEPH ; (11 T) LD A,0AH ; ( 8 T) OUT (PPI.CM),A ;Output low level (11 T) POP AF ;Restore data (12 T) ; RET ; (11 T) TAPION: ; ; Detect header block ; LD A,8 ;Motor on OUT (PPI.CM),A DI LD A,0EH ;Select PSG port A OUT (PSG.LW),A SYN05: ; ; First, wait until a series of good pulses are found. ; LD HL,0457H ;Initialize counter ;Number of pulse to detect header SYN10: LD D,C ;Remember last value CALL CNTFUL ;Count full cycle RET C ;Aborted LD A,C ;Get count CP 0DEH ;0DE = Max count JR NC,SYN05 ;Too long, reset number of pulses CP 5 ;5 = Min count JR C,SYN05 ;Too short, reset number of pulses ; ; Now compare with last pulse width and approve this as a good pulse ; if this is similar to last one. ; SUB D ;current - last JR NC,SYN11 CPL ;result was negative, negate it INC A SYN11: CP 4 ;within a wow allowance? JR NC,SYN05 ;no, reset number of pulse ever seen DEC HL LD A,H OR L JR NZ,SYN10 ;Loop till seen enough good pulses ; SYN20: ; ; Next, calculate the mean width of pulse. ; LD HL,0 ;Initialize sum LD B,L ;Initialize high byte of [BC] pair LD D,L ;Loop 256 times SYN30: CALL CNTFUL RET C ADD HL,BC DEC D JP NZ,SYN30 LD BC,06AEH ;compensate over head ADD HL,BC ; ; Set various values for read routine. Those are, ; ; LOWLIM - lower limit of the width of start bit. [H]*1.5 ; WINWID - width of window to count the transition. ; LD A,H ;[H] has mean pulse width RRA AND 7FH LD D,A ;[D]=[mean]/2 ADD HL,HL LD A,H ;[A]=[mean]x2 SUB D ;[A]=[mean]x1.5 LD D,A ;save SUB 6 ;compensate overhead at DATAR LD (LOWLIM),A ; ; Set width of window 'WINWID' ; CNTFUL takes 40T for a loop, RDBIT takes 60T for loop ; set WINWID as 3 times wider than single short pulse ([mean]/2) ; [WINWID]=[mean] x 1.5 x 40/60 ; =[D] x 2/3 ; LD A,D ;get [mean width]x1.75 ADD A,A ;x2 LD B,0 ;clear quotient SULOP: SUB 3 INC B JR NC,SULOP ;loop till get carry LD A,B ;[A]=[mean]x1.75x2/3 SUB 3 ;compensate overhead in RDBIT routine LD (WINWID),A OR A RET TAPIN: ; ; Read a byte from cassette ; LD A,(LOWLIM) LD D,A ;[D] has lower limit for start bit DATAR: CALL BREAKX RET C ;Aborted IN A,(PSG.DR) ;Get cassette RLCA ;High state? JR NC,DATAR ;No DATAR0: CALL BREAKX RET C ;Aborted IN A,(PSG.DR) ;Get cassette RLCA ;falling egde? JR C,DATAR0 ;No LD E,0 ;Initialize edge mask CALL CNTHLF ;Get width in [C] DATAR1: LD B,C ;Save old width CALL CNTHLF ;Get new width in [C] RET C ;aborted LD A,B ;Add width of 2 pulses ADD A,C JP C,DATAR1 ;Pulse too long CP D ;Longer than lower limit? JR C,DATAR1 ;No ; ; Now, a valid start bit has been found. ; [E] = 0 if NORMAL polarity, ; =255 if REVERSE polarity. ; LD L,8 ;Initialize counter DATARL: CALL RDBIT CP 3+1 ;Legal transitions? CCF RET C ;Too many transitions CP 2 CCF ;Set carry if 2 or 3 transitions RR D ; ; We've just assembled a bit. A check must be done to make sure ; that we're at the start of next bit field. ; LD A,C ;Reget number of transitions RRCA CALL NC,CNTHL0 ;Wait for next transition if 0 or 2 CALL CNTHLF DEC L JP NZ,DATARL ;Loop till done CALL BREAKX ;return with carry set if breaked LD A,D RET RDBIT: ; ; Count number of transitions within a period specified by 'WINWID' ; ; length of window = 17uSec x [WINWID] + 12.3 uSec ; ; [D],[H] and [L] are preserved. ; [E] is updated to prepare for next edge ; LD A,(WINWID) ;Get width of window LD B,A LD C,0 ;Clear # of transitions seen RDBITL: IN A,(PSG.DR) ;Get a bit XOR E ;Any changes? JP P,NOTRAN ;No LD A,E ;Transition seen CPL ;Prepare for next transition LD E,A INC C ;Increment # of transitions DJNZ RDBITL LD A,C ;Get transition count RET NOTRAN: ; NOP ;Compensate time NOP NOP NOP DJNZ RDBITL ; LD A,C ;Get transition count RET CNTHLF: ; ; Count half cycle ; 1T =279.4nS ; period=[C] x 11.18 + 35.48uS ; CALL BREAKX ;Break? (87 T) RET C ;Yes, aborted ( 6 T) CNTHL0: LD C,0 ;Initialize counter ( 8 T) CNTHL1: INC C ;# of state for this loop ;40T=11.18usec ( 5 T) JR Z,TIMOUT ;Pulse too long ( 8 T) IN A,(PSG.DR) ;Read cassette (11 T) XOR E ;Desired transition? ( 5 T) JP P,CNTHL1 ;No (11 T) LD A,E ;Complement edge mask ( 5 T) CPL ; ( 5 T) LD E,A ; ( 5 T) RET ; (11 T) TIMOUT: ; DEC C ;Load 255 RET CNTFUL: ; ; Count full cycle ; CALL BREAKX RET C ;Aborted IN A,(PSG.DR) ;Get cassette RLCA ;Low state? JR C,CNTFUL ;No LD E,0 ;Initialize edge mask CALL CNTHL0 JP CNTHL1 SUBTTL - BIO - OUTDO routine OUTDO: ; ; OUTDO ( RST 18H ) ; Prints char in [A] , to either terminal or disk ; or printer depending on the flags: ; PRTFLG if non-zero print to printer ; PTRFIL if non-zero print to disk file pointed ; to by PTRFIL ; PUSH AF ;Save character CALL H.OUTD CALL ISFLIO ;Doing I/O to file? JR Z,LPTCOD ;Nope, check for output to printer POP AF ;Restore char. LD IX,FILOU1 ;Jump with pointer to FILE OUT routine JP CALBAS ; LPTCOD: LD A,(PRTFLG) ;Output to printer? OR A JR Z,TTYCHR ;Nope, output to console LD A,(RAWPRT) ;Print in "RAW" mode? AND A JR NZ,LPTCH1 ;Yes, send char to printer POP AF ;restore char ; OUTDLP: PUSH AF ; NTBKS2: CP 9 ;TAB? JR NZ,NOTABL ;No ; MORSPL: LD A,' ' ;Print a space CALL OUTDLP LD A,(LPTPOS) ;Get current LPOS AND 7 ;At TAB stop? JR NZ,MORSPL ;No, back for more space POP AF ;Discard character RET ; NOTABL: SUB 0DH ;Check if CR. If so load a zero JR Z,ZERLP1 ;It is, clear LPTPOS and send CR JR C,LPTCH0 ;Code is 0..00H, just send ;without modify LPTPOS CP " "-13 ;See if control character JR C,LPTCH0 ;Code is 0EH..1FH, ditto LD A,(LPTPOS) ;Get LPOS INC A ; ZERLP1: LD (LPTPOS),A ;Update LPOS ; LPTCH0: LD A,(NTMSXP) ;Output to MSX standard printer AND A JR Z,LPTCH1 ;No mapping for KATAKANA to HIRAGANA POP AF ;restore char to print CALL CNVCHR ;See if graphic header RET NC ;Yep JR NZ,MAPSPC ;Graphic symbol, map to space AND A JP P,LPTCHR CP 86H ;Graphic symbol? JR C,MAPSPC ;Yes, map this to space too! CP 0A0H ;A HIRAGANA(part 1)? JR NC,NTHIRA ADD A,' ' ;Map to KATAKANA JR LPTCHR NTHIRA: CP 0E0H ;HIRAGANA(part 2)? JR C,LPTCHR ;No SUB ' ' ;Map to KATAKANA DB 38H ;'JRC' instruction (Skip next byte) LPTCH1: POP AF ;Restore char ; LPTCHR: CALL LPTOUT ;Send character out RET NC ;Sent successful LD IX,DIOERR ;Direct I/O error JP CALBAS MAPSPC: LD A,' ' JR LPTCHR TTYCHR: ; ; Output to console ; POP AF ;Get the character JP CHPUT SUBTTL -MSXCHR- MSX character set CGTABL: DB 00H,00H,00H,00H,00H,00H,00H DB 00H,7EH,42H,7EH,42H,7EH,42H DB 82H,00H,10H,92H,54H,10H,28H DB 44H,82H,00H,12H,14H,0F8H,14H DB 34H,52H,92H,00H,10H,10H,0FEH DB 10H,38H,54H,92H,00H,10H,28H DB 7CH,92H,38H,54H,0FEH,00H,10H DB 10H,10H,7CH,10H,10H,0FEH,00H DB 7EH,42H,42H,7EH,42H,42H,7EH DB 00H,40H,7EH,48H,3CH,28H,7EH DB 08H,00H,0FEH,92H,92H,0FEH,82H DB 82H,86H,00H,04H,0EEH,0A4H,0EFH DB 0A2H,0EAH,06H,00H,28H,44H,82H DB 3CH,14H,24H,4CH,00H,28H,0C8H DB 5CH,0EAH,6CH,0C8H,50H,00H,7CH DB 20H,7CH,44H,7CH,44H,7CH,00H DB 0CH,70H,10H,0FEH,10H,10H,10H DB 00H,7EH,10H,1EH,12H,22H,44H DB 08H,00H,00H,7CH,28H,28H,28H DB 4EH,00H,00H,10H,10H,10H,0FFH DB 00H,00H,00H,00H,00H,00H,00H DB 0FFH,10H,10H,10H,10H,10H,10H DB 10H,0F0H,10H,10H,10H,10H,10H DB 10H,10H,1FH,10H,10H,10H,10H DB 10H,10H,10H,0FFH,10H,10H,10H DB 10H,10H,10H,10H,10H,10H,10H DB 10H,10H,00H,00H,00H,0FFH,00H DB 00H,00H,00H,00H,00H,00H,1FH DB 10H,10H,10H,10H,00H,00H,00H DB 0F0H,10H,10H,10H,10H,10H,10H DB 10H,1FH,00H,00H,00H,00H,10H DB 10H,10H,0F0H,00H,00H,00H,00H DB 81H,42H,24H,18H,18H,24H,42H DB 81H,10H,7CH,10H,10H,28H,44H DB 82H,00H,10H,10H,0FEH,92H,0FEH DB 10H,10H,00H,10H,10H,54H,54H DB 92H,10H,30H,00H,00H,00H,00H DB 00H,00H,00H,00H,00H,20H,20H DB 20H,20H,00H,00H,20H,00H,50H DB 50H,50H,00H,00H,00H,00H,00H DB 50H,50H,0F8H,50H,0F8H,50H,50H DB 00H,20H,78H,0A0H,70H,28H,0F0H DB 20H,00H,0C0H,0C8H,10H,20H,40H DB 98H,18H,00H,40H,0A0H,40H,0A8H DB 90H,98H,60H,00H,10H,20H,40H DB 00H,00H,00H,00H,00H,10H,20H DB 40H,40H,40H,20H,10H,00H,40H DB 20H,10H,10H,10H,20H,40H,00H DB 20H,0A8H,70H,20H,70H,0A8H,20H DB 00H,00H,20H,20H,0F8H,20H,20H DB 00H,00H,00H,00H,00H,00H,00H DB 20H,20H,40H,00H,00H,00H,78H DB 00H,00H,00H,00H,00H,00H,00H DB 00H,00H,60H,60H,00H,00H,00H DB 08H,10H,20H,40H,80H,00H,70H DB 88H,98H,0A8H,0C8H,88H,70H,00H DB 20H,60H,0A0H,20H,20H,20H,0F8H DB 00H,70H,88H,08H,10H,60H,80H DB 0F8H,00H,70H,88H,08H,30H,08H DB 88H,70H,00H,10H,30H,50H,90H DB 0F8H,10H,10H,00H,0F8H,80H,0E0H DB 10H,08H,10H,0E0H,00H,30H,40H DB 80H,0F0H,88H,88H,70H,00H,0F8H DB 88H,10H,20H,20H,20H,20H,00H DB 70H,88H,88H,70H,88H,88H,70H DB 00H,70H,88H,88H,78H,08H,10H DB 60H,00H,00H,00H,20H,00H,00H DB 20H,00H,00H,00H,00H,20H,00H DB 00H,20H,20H,40H,18H,30H,60H DB 0C0H,60H,30H,18H,00H,00H,00H DB 0F8H,00H,0F8H,00H,00H,00H,0C0H DB 60H,30H,18H,30H,60H,0C0H,00H DB 70H,88H,08H,10H,20H,00H,20H DB 00H,70H,88H,08H,68H,0A8H,0A8H DB 70H,00H,20H,50H,88H,88H,0F8H DB 88H,88H,00H,0F0H,48H,48H,70H DB 48H,48H,0F0H,00H,30H,48H,80H DB 80H,80H,48H,30H,00H,0E0H,50H DB 48H,48H,48H,50H,0E0H,00H,0F8H DB 80H,80H,0F0H,80H,80H,0F8H,00H DB 0F8H,80H,80H,0F0H,80H,80H,80H DB 00H,70H,88H,80H,0B8H,88H,88H DB 70H,00H,88H,88H,88H,0F8H,88H DB 88H,88H,00H,70H,20H,20H,20H DB 20H,20H,70H,00H,38H,10H,10H DB 10H,90H,90H,60H,00H,88H,90H DB 0A0H,0C0H,0A0H,90H,88H,00H,80H DB 80H,80H,80H,80H,80H,0F8H,00H DB 88H,0D8H,0A8H,0A8H,88H,88H,88H DB 00H,88H,0C8H,0C8H,0A8H,98H,98H DB 88H,00H,70H,88H,88H,88H,88H DB 88H,70H,00H,0F0H,88H,88H,0F0H DB 80H,80H,80H,00H,70H,88H,88H DB 88H,0A8H,90H,68H,00H,0F0H,88H DB 88H,0F0H,0A0H,90H,88H,00H,70H DB 88H,80H,70H,08H,88H,70H,00H DB 0F8H,20H,20H,20H,20H,20H,20H DB 00H,88H,88H,88H,88H,88H,88H DB 70H,00H,88H,88H,88H,88H,50H DB 50H,20H,00H,88H,88H,88H,0A8H DB 0A8H,0D8H,88H,00H,88H,88H,50H DB 20H,50H,88H,88H,00H,88H,88H DB 88H,70H,20H,20H,20H,00H,0F8H DB 08H,10H,20H,40H,80H,0F8H,00H DB 70H,40H,40H,40H,40H,40H,70H DB 00H,88H,50H,20H,70H,20H,70H DB 20H,00H,70H,10H,10H,10H,10H DB 10H,70H,00H,20H,50H,88H,00H DB 00H,00H,00H,00H,00H,00H,00H DB 00H,00H,00H,0F8H,00H,40H,20H DB 10H,00H,00H,00H,00H,00H,00H DB 00H,70H,08H,78H,88H,78H,00H DB 80H,80H,0B0H,0C8H,88H,0C8H,0B0H DB 00H,00H,00H,70H,88H,80H,88H DB 70H,00H,08H,08H,68H,98H,88H DB 98H,68H,00H,00H,00H,70H,88H DB 0F8H,80H,70H,00H,10H,28H,20H DB 0F8H,20H,20H,20H,00H,00H,00H DB 68H,98H,98H,68H,08H,70H,80H DB 80H,0F0H,88H,88H,88H,88H,00H DB 20H,00H,60H,20H,20H,20H,70H DB 00H,10H,00H,30H,10H,10H,10H DB 90H,60H,40H,40H,48H,50H,60H DB 50H,48H,00H,60H,20H,20H,20H DB 20H,20H,70H,00H,00H,00H,0D0H DB 0A8H,0A8H,0A8H,0A8H,00H,00H,00H DB 0B0H,0C8H,88H,88H,88H,00H,00H DB 00H,70H,88H,88H,88H,70H,00H DB 00H,00H,0B0H,0C8H,0C8H,0B0H,80H DB 80H,00H,00H,68H,98H,98H,68H DB 08H,08H,00H,00H,0B0H,0C8H,80H DB 80H,80H,00H,00H,00H,78H,80H DB 0F0H,08H,0F0H,00H,40H,40H,0F0H DB 40H,40H,48H,30H,00H,00H,00H DB 90H,90H,90H,90H,68H,00H,00H DB 00H,88H,88H,88H,50H,20H,00H DB 00H,00H,88H,0A8H,0A8H,0A8H,50H DB 00H,00H,00H,88H,50H,20H,50H DB 88H,00H,00H,00H,88H,88H,98H DB 68H,08H,70H,00H,00H,0F8H,10H DB 20H,40H,0F8H,00H,18H,20H,20H DB 40H,20H,20H,18H,00H,20H,20H DB 20H,00H,20H,20H,20H,00H,0C0H DB 20H,20H,10H,20H,20H,0C0H,00H DB 40H,0A8H,10H,00H,00H,00H,00H DB 00H,00H,00H,00H,00H,00H,00H DB 00H,00H,10H,38H,7CH,0FEH,0FEH DB 38H,7CH,00H,6CH,0FEH,0FEH,0FEH DB 7CH,38H,10H,00H,38H,38H,0FEH DB 0FEH,0D6H,10H,7CH,00H,10H,38H DB 7CH,0FEH,7CH,38H,10H,00H,00H DB 78H,84H,84H,84H,84H,78H,00H DB 00H,78H,0FCH,0FCH,0FCH,0FCH,78H DB 00H,40H,0FEH,48H,70H,48H,82H DB 7CH,00H,00H,00H,10H,7EH,3CH DB 5AH,34H,00H,00H,00H,40H,42H DB 42H,52H,20H,00H,00H,00H,1CH DB 1CH,22H,02H,0CH,00H,00H,00H DB 18H,7EH,18H,30H,6EH,00H,00H DB 00H,12H,7EH,3CH,52H,34H,00H DB 00H,00H,28H,7CH,2AH,22H,24H DB 00H,00H,00H,08H,5CH,6AH,0CH DB 30H,00H,00H,00H,08H,0EH,38H DB 4CH,3AH,00H,00H,00H,00H,3CH DB 02H,02H,1CH,00H,00H,00H,00H DB 00H,00H,00H,00H,00H,20H,0FEH DB 20H,7CH,0AAH,0B2H,64H,00H,00H DB 80H,82H,82H,82H,90H,60H,00H DB 1CH,00H,7CH,02H,02H,04H,18H DB 00H,38H,00H,0FEH,08H,30H,50H DB 9EH,00H,20H,0FAH,22H,7CH,0A2H DB 0A2H,4CH,00H,40H,44H,0F2H,4AH DB 48H,88H,30H,00H,10H,0FCH,08H DB 3EH,04H,80H,7CH,00H,18H,18H DB 30H,60H,60H,30H,18H,00H,04H DB 84H,0BEH,84H,84H,84H,48H,00H DB 00H,0FCH,02H,00H,40H,80H,7EH DB 00H,10H,16H,0F8H,08H,7CH,80H DB 78H,00H,80H,80H,80H,80H,84H DB 88H,70H,00H,08H,0FEH,08H,38H DB 48H,38H,08H,00H,04H,44H,0FEH DB 44H,44H,40H,3EH,00H,64H,28H DB 30H,0FEH,20H,40H,3CH,00H,00H DB 00H,00H,00H,00H,00H,00H,00H DB 00H,00H,00H,00H,60H,90H,60H DB 00H,38H,20H,20H,20H,00H,00H DB 00H,00H,00H,00H,00H,20H,20H DB 20H,0E0H,00H,00H,00H,00H,00H DB 80H,40H,20H,00H,00H,00H,00H DB 30H,30H,00H,00H,00H,0F8H,08H DB 0F8H,08H,10H,20H,40H,00H,00H DB 00H,0F0H,10H,60H,40H,80H,00H DB 00H,10H,20H,60H,0A0H,20H,20H DB 00H,00H,20H,0F0H,90H,10H,20H DB 40H,00H,00H,00H,0F0H,20H,20H DB 20H,0F0H,00H,00H,20H,0F0H,60H DB 0A0H,0A0H,20H,00H,00H,40H,0F8H DB 48H,50H,40H,40H,00H,00H,00H DB 70H,10H,10H,10H,0F8H,00H,00H DB 00H,0F0H,10H,0F0H,10H,0F0H,00H DB 00H,00H,0A8H,0A8H,08H,10H,20H DB 00H,00H,00H,00H,0F8H,00H,00H DB 00H,00H,0F8H,08H,28H,30H,20H DB 20H,40H,00H,08H,10H,20H,60H DB 0A0H,20H,20H,00H,20H,0F8H,88H DB 88H,08H,10H,20H,00H,00H,0F8H DB 20H,20H,20H,20H,0F8H,00H,10H DB 0F8H,10H,30H,50H,90H,10H,00H DB 20H,0F8H,28H,28H,28H,48H,88H DB 00H,20H,0F8H,20H,0F8H,20H,20H DB 20H,00H,78H,48H,88H,08H,08H DB 10H,20H,00H,40H,78H,50H,90H DB 10H,10H,20H,00H,00H,0F8H,08H DB 08H,08H,08H,0F8H,00H,50H,0F8H DB 50H,50H,10H,10H,20H,00H,00H DB 0C0H,08H,0C8H,08H,10H,0E0H,00H DB 00H,0F8H,08H,10H,20H,50H,88H DB 00H,40H,0F8H,48H,50H,40H,40H DB 38H,00H,88H,88H,48H,08H,10H DB 20H,40H,00H,78H,48H,78H,88H DB 08H,10H,20H,00H,10H,0E0H,20H DB 0F8H,20H,20H,40H,00H,0A8H,0A8H DB 0A8H,08H,08H,10H,20H,00H,70H DB 00H,0F8H,20H,20H,20H,40H,00H DB 40H,40H,60H,50H,48H,40H,40H DB 00H,20H,0F8H,20H,20H,20H,20H DB 40H,00H,00H,70H,00H,00H,00H DB 00H,0F8H,00H,00H,0F8H,08H,0D0H DB 20H,50H,88H,00H,20H,0F8H,08H DB 30H,0E8H,20H,20H,00H,08H,08H DB 08H,10H,20H,40H,80H,00H,20H DB 10H,48H,48H,48H,48H,88H,00H DB 80H,80H,0F8H,80H,80H,80H,78H DB 00H,0F8H,08H,08H,08H,10H,20H DB 40H,00H,00H,40H,0A0H,10H,08H DB 08H,00H,00H,20H,0F8H,20H,20H DB 0A8H,0A8H,20H,00H,00H,0F8H,08H DB 08H,50H,20H,10H,00H,0F0H,00H DB 60H,00H,00H,0F0H,08H,00H,10H DB 20H,40H,80H,90H,88H,0F8H,00H DB 08H,08H,08H,50H,20H,50H,80H DB 00H,78H,20H,0F8H,20H,20H,20H DB 18H,00H,40H,0F8H,48H,48H,50H DB 40H,40H,00H,00H,70H,10H,10H DB 10H,10H,0F8H,00H,00H,0F8H,08H DB 0F8H,08H,08H,0F8H,00H,70H,00H DB 0F8H,08H,08H,10H,20H,00H,48H DB 48H,48H,48H,48H,10H,20H,00H DB 10H,50H,50H,50H,50H,58H,90H DB 00H,40H,40H,40H,48H,48H,50H DB 60H,00H,00H,0F8H,88H,88H,88H DB 88H,0F8H,00H,0F8H,88H,88H,08H DB 08H,10H,20H,00H,00H,0C0H,00H DB 08H,08H,10H,0E0H,00H,90H,48H DB 00H,00H,00H,00H,00H,00H,60H DB 90H,60H,00H,00H,00H,00H,00H DB 40H,0FEH,40H,5EH,80H,0A0H,9EH DB 00H,20H,0FEH,40H,0F8H,04H,04H DB 78H,00H,00H,00H,0FCH,02H,02H DB 04H,38H,00H,00H,0FEH,0CH,30H DB 40H,40H,38H,00H,10H,12H,1CH DB 30H,40H,40H,3EH,00H,24H,0F2H DB 48H,48H,9CH,0AAH,10H,00H,80H DB 9EH,80H,80H,0A0H,0BEH,0C0H,00H DB 44H,4CH,7AH,0AAH,0A6H,0AAH,6CH DB 00H,40H,0ECH,52H,62H,0CEH,4AH DB 4CH,00H,00H,38H,54H,92H,0A2H DB 0A2H,4CH,00H,04H,0BEH,84H,84H DB 9EH,0A4H,5CH,00H,08H,4CH,0C6H DB 46H,44H,44H,38H,00H,20H,18H DB 20H,16H,8AH,0CAH,18H,00H,00H DB 20H,70H,0D8H,8CH,06H,02H,00H DB 3EH,84H,0BEH,84H,9CH,0A6H,18H DB 00H,08H,7EH,08H,7EH,38H,4CH DB 3AH,00H,0E0H,24H,24H,7EH,0A4H DB 0A4H,68H,00H,20H,0FCH,24H,62H DB 0A0H,62H,3CH,00H,04H,44H,7CH DB 0C6H,0AAH,92H,64H,00H,20H,20H DB 78H,20H,78H,22H,1CH,00H,00H DB 48H,0FCH,4AH,42H,4CH,40H,00H DB 08H,0BCH,0CAH,8AH,0BCH,08H,30H DB 00H,08H,08H,0EH,08H,78H,8CH DB 72H,00H,38H,84H,80H,0FCH,0C2H DB 02H,38H,00H,00H,42H,42H,42H DB 62H,04H,18H,00H,7CH,08H,30H DB 0DCH,62H,92H,7CH,00H,20H,2CH DB 0F4H,24H,64H,0E4H,26H,00H,7CH DB 18H,20H,5CH,82H,02H,7CH,00H DB 40H,60H,0DCH,62H,42H,0C2H,5CH DB 00H,10H,30H,20H,70H,48H,0CEH DB 84H,00H,00H,00H,00H,00H,00H DB 00H,00H,00H,00H,00H,00H,00H DB 00H,00H,00H,00H SUBTTL - MSXINL, Screen editor - Line input and function character PINLIN: ; ; Main entry point ; CALL H.PINL LD A,(AUTFLG) ;During AUTO mode? AND A JR NZ,INLIN ;Yes, then fake INLIN to prevent 0 from ;deleting line number LD L,0 JR INLIN1 QINLIN: ; ; Output question mark then get input ; CALL H.QINL LD A,'?' RST 18H LD A,' ' RST 18H INLIN: CALL H.INLI LD HL,(CSRY) DEC L CALL NZ,TERMIN ;Terminate previous line INC L INLIN1: LD (FSTPOS),HL ;Mark first position XOR A LD (INTFLG),A INLIN2: CALL CHGET LD HL,SCITBL-2 LD C,0BH ;SCI Max CALL INDJMP ;Do functions PUSH AF CALL NZ,INLOUT ;Output a character POP AF JR NC,INLIN2 ;Not a terminator ; ; return to BASIC (break or CR) ; LD HL,BUFMIN RET Z ;Cnt-C, return with carry set CCF ;No, return carry clear RETURN: RET INLOUT: ; PUSH AF ;Save character to output CP 9 ;TAB? JR NZ,OUTNTB ;Nope POP AF ;Discard stack OUTTAB: LD A,' ' ;Map to space CALL INLOUT LD A,(CSRX) DEC A ;Make it zero based. AND 7 ;Reached TAB stop? JR NZ,OUTTAB ;Not yet, continue... RET OUTNTB: ; POP AF ;Restore character LD HL,INSFLG ;points insert mode flag CP 1 ;Graphic header byte? JR Z,INLOT0 ;Yes, send as is CP ' ' ;control char? JR C,INLOT1 ;branch if so. - Reset insert mode PUSH AF ;save char to output LD A,(HL) ;get insert mode flag AND A ;test CALL NZ,INSERT ;if insert mode, make room to insert POP AF ;restore char to output INLOT0: RST 18H ;output char RET INLOT1: ; LD (HL),0 ;reset insert mode RST 18H ;send this control char DB 3EH SETINS: DB 3EH ;Set insert mode and exit SETOVW: XOR A ;Set overwrite mode PUSH AF CALL CKERCS POP AF LD (CSTYLE),A JP CKDPCS SCITBL: ; ; Table of function characters ; DB 08H ;Delete previous char DW DELETE DB 12H ;Toggle insert flag DW TGLINS DB 1BH ;Escape DW RETURN DB 02H ;Back word DW LBCKWD DB 06H ;Next word DW LNXTWD DB 0EH DW LAPPND DB 05H ;Erase to end of line DW TRUNC DB 03H ;Abort DW LBREAK DB 0DH ;Carriage return DW LCRRET DB 15H ;Delete whole line DW LERASE DB 7FH ;Delete character at cursor DW LDELNX SUBTTL - MSXINL, Screen editor - Process special characters LCRRET: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ; Carriage return ; ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; CALL GTFRST ;L=line number of first visual LD A,(AUTFLG) ;During AUTO mode? AND A JR Z,NOTAUT ;No LD H,1 ;Always get from top of line during AUTO mode NOTAUT: PUSH HL ; ; Put logical starting at L into BUF ; CALL CKERCS POP HL LD DE,BUF ;Line buffer pointer LD B,0FEH ;Max count DEC L LCR1: INC L LCR2: PUSH DE ;Save buffer pointer PUSH BC ;Save buffer count CALL GETVRM ;Get current character in Acc POP BC ;Restore buffer count POP DE ;Restore buffer pointer AND A ;Null? JR Z,LCRNUL ;Yes, ignore this CP ' ' ;Special graphic character? JR NC,LCRNRM ;No, proceed normally DEC B ;Decrement BUF size counter before storing JR Z,LBLKSP ;At end of BUF, so ignore this LD C,A LD A,1 ;Store header byte for graphic symbol LD (DE),A INC DE LD A,C ADD A,'@' LCRNRM: LD (DE),A ;Store byte in buffer INC DE ;Bump buffer pointer DEC B ;Decrement BUF size counter JR Z,LBLKSP ;At end of BUF LCRNUL: INC H ;Next column LD A,(LINLEN) ;Max column reached? CP H ; JR NC,LCR2 ;Not yet PUSH DE ;Save buffer pointer CALL GETTRM ;Is this line terminated? POP DE ;Restore buffer pointer LD H,1 ;Assume not, start from top of next line JR Z,LCR1 ;No LBLKSP: ; ; Suppress trailing blanks, [ DE]=1ast+1 ; DEC DE ;Back up buffer pointer LD A,(DE) ;Get stored character CP ' ' ;Is it space? JR Z,LBLKSP ;Yes, ignore this PUSH HL PUSH DE CALL CKDPCS POP DE POP HL ; ; Terminate ; INC DE ;Point past last valid character XOR A ;Load terminator LD (DE),A ;Put it in BUF FAKECR: LD A,0DH ;Load character to echo to console AND A ;Reset Z-flag, (say not break) LNXTLN: PUSH AF ;Save this flag CALL TERMIN CALL POSIT ;Save current cursor position LD A,0AH RST 18H ;Move cursor to start of next line XOR A ;Clear possible INSFLG LD (INSFLG),A POP AF ;Restore flags SCF ;Set carry indicating end of input POP HL ;Discard return address (XRA A;RET) RET ;If break, Z flag is set LBREK0: ; ; Control-C input ; INC L ;Bump line counter LBREAK: CALL GETTRM ;Line terminated? JR Z,LBREK0 ;No, check next line CALL SETOVW ;Set to overwrite mode XOR A ;Load 0 in Acc, and set Z flag LD (BUF),A ;Say no character in BUF LD H,1 ;Set to first column PUSH HL ;Save cursor position CALL GICINI ;Initialize sound chip and queue CALL CKSTTP ;Check if STOP trap is active or not POP HL JR C,FAKECR ;Yes, fake CR LD A,(BASROM) ;Executing BASIC program in ROM? AND A JR NZ,FAKECR ;Yes, fake CR JR LNXTLN TGLINS: ; ; Toggle insert mode flag ; LD HL,INSFLG ;Get current insert flag LD A,(HL) XOR 0FFH ;Toggle insert status and affect Z flag LD (HL),A JP Z,SETOVW ;Set to overwrite mode JP SETINS ;Set to insert mode INSERT: ; ; Insert a blank ; CALL CKERCS ;Erase cursor before operation LD HL,(CSRY) LD C,' ' ;Load raw code for space INS1: PUSH HL ;Save current cursor position INS2: PUSH BC ;Save previous character CALL GETVRM ;Get current character in C POP DE ;Restore previous character in [E] PUSH BC ;Save current character LD C,E ;C=previous character CALL PUTVRM ;Put it on screen POP BC ;Restore current character in C LD A,(LINLEN) ;Check if end of line INC H ;Bump column counter CP H ;End of line? LD A,D ;Get current attribute in Acc JR NC,INS2 ;If not, continue till end of line ; ; Now we just finished a line, code of character wrapped to next ; line is held in [C]. ; POP HL ;Restore current cursor position CALL GETTRM ;Is this line terminated? JR Z,INS6 ;Line not terminated on this visual ; ; The current line is terminated. A check must be made to ; determine if a wrapped character is a space, or we're inserting ; at the end-of-line. If so, we have to open a next line to ; insert. ; LD A,C ;Move last character to A for comparison CP ' ' PUSH AF ;Save the condition JR NZ,INS3 ;No, open next line LD A,(LINLEN) ;Are we trying to insert at the EOL? CP H ; JR Z,INS3 ;Yes, open next line POP AF ;Discard stack JP CKDPCS ;Display cursor again INS3: ; CALL UNTERM ;Unterminate this line INC L ;Go to next row PUSH BC ;Save character code PUSH HL ;Save position of character in operation CALL GETLEN ;Bottom of screen? CP L ; JR C,INS4 ;Yes ; ; Scroll down starting at line L ; CALL INSLN0 ;Insert a blank line there JR INS5 INS4: ; ; Scroll up ; LD HL,CSRY DEC (HL) JR NZ,INS45 INC (HL) INS45: LD L,1 CALL DELLN0 POP HL DEC L PUSH HL INS5: POP HL POP BC POP AF ;Restore flags JP Z,CKDPCS ;If we were trying to insert at the ;end-of-line, nothing else to do DEC L ;Cancel next 'INR L' INS6: ; ; Not end of logical line, pass character to next line ; INC L ;Bump row counter LD H,1 ;Start from first column JR INS1 ;Pass character to next line LDELNX: ; ; Delete current character ; LD A,(LINLEN) CP H ;At rightmost position? JR NZ,LDELX1 ;Nope CALL GETTRM ;Is this a terminated line? JR NZ,DELET5 ;Yes, place a space there. LDELX1: LD A,1CH ;Move cursor right RST 18H LD HL,(CSRY) ;Fall into 'delete prof. character' DELETE: ; ; Delete previous character ; PUSH HL CALL CKERCS POP HL DEC H ;Are we at top of line? JP NZ,DELET2 ;No INC H ;Yes PUSH HL ;Save current cursor position DEC L ;Look a line above JR Z,DELET1 ;At top of screen LD A,(LINLEN) LD H,A CALL GETTRM ;Is previous line terminated? JR NZ,DELET1 ;Yes EX (SP),HL ;No, substitue by current HL DELET1: POP HL ;Get saved cursor position DELET2: LD (CSRY),HL ;Set new cursor position DELET3: LD A,(LINLEN) CP H JR Z,DELET5 ;Just over strike with blank INC H DELET4: CALL GETVRM ;Get current character and attribute DEC H CALL PUTVRM ;Output it to left of current position INC H INC H LD A,(LINLEN) INC A CP H JR NZ,DELET4 ;Do next till end of visual DEC H DELET5: LD C,' ' ;Load raw code for space CALL PUTVRM CALL GETTRM JP NZ,CKDPCS ;End of line, all done PUSH HL INC L LD H,1 CALL GETVRM ;Get first character next visual EX (SP),HL CALL PUTVRM ;Put at last position last line POP HL JR DELET3 LERASE: ; ; Erase logical line ; CALL CKERCS CALL GTFRST ;Set L=first visual this logical line LD (CSRY),HL JR TRUNC1 TRUNC: ; ; Truncate logical line ; PUSH HL CALL CKERCS POP HL TRUNC1: CALL GETTRM ;Is this line terminated? PUSH AF ;Save the condition CALL EOL ;Erase to end-of-line POP AF ;Restore condition JR NZ,DPCSOW ;Yes LD H,1 ;Go to next line INC L ;Bump row counter JR TRUNC1 ;And continue DPCSOW: ; CALL CKDPCS XOR A LD (INSFLG),A JP SETOVW LAPPND: ; ; Append to current line ; CALL CKERCS ;Erase cursor LD HL,(CSRY) ;Get current cursor position DEC L LAP1: INC L CALL GETTRM ;Line terminated? JR Z,LAP1 ;No, look at next line LD A,(LINLEN) LD H,A INC H LAP2: DEC H ;Reached start of line? JR Z,LAP3 ;Yes CALL GETVRM ;Get a character at the cursor CP ' ' ;Space? JR Z,LAP2 ;Yes, skip this LAP3: CALL ADVCUR ;Advance cursor to point to end of line JR DPCSOW ;Re-display cursor LNXTWD: ; ; Move to next word ; CALL CKERCS CALL PRVCHK LNW1: CALL NXTCHK ;Still in word? JR Z,DPCSOW ;Reached screen bottom, abort JR C,LNW1 ;Yes LNW2: CALL NXTCHK ;Reached word? JR Z,DPCSOW ;Reached screen bottom, abort JR NC,LNW2 ;Not yet JR DPCSOW LBCKWD: ; ; Move to previous word ; CALL CKERCS LBW1: CALL PRVCHK ;Still in separator? JR Z,DPCSOW ;Reached screen top, abort JR NC,LBW1 ;Yes LBW2: CALL PRVCHK ;Reached separator? JR Z,DPCSOW ;Reached screen top, abort JR C,LBW2 ;Not yet CALL ADVCUR JR DPCSOW NXTCHK: ; ; Move right and check ; LD HL,(CSRY) ;Get current cursor position CALL ADVCUR ;Advance cursor CALL GETLEN ;Get an actual height of screen LD E,A ;[D],[E] hold the dead end position LD A,(LINLEN) LD D,A JR PRVCK1 PRVCHK: ; ; Move left and check ; LD HL,(CSRY) ;Get current cursor position CALL BS ;Regress cursor LD DE,0101H ;[D],[E] hold the dead end position PRVCK1: ; ; Check current character ; Carry set if the character is regarded as separator ; LD HL,(CSRY) ;Get updated cursor position RST 20H ;Reached dead end? RET Z ;Yes, return with Z flag LD DE,RESZRO ;Jump to RESZRO when done PUSH DE CALL GETVRM ;Get ASCII code of character at [H],[L] CP '0' ;Set carry if "0".."9" CCF RET NC CP ':' RET C CP 'A' ;Set carry if "A".."Z" CCF RET NC CP 'Z'+1 RET C CP 'a' ;Set carry if "a".."z" CCF RET NC CP 'z'+1 RET C CP 86H ;Check for Hiragana (86H) CCF RET NC CP 0A0H RET C CP 0A6H CCF RESZRO: LD A,0 ;Reset Z flag without affecting C flag INC A RET ; ; Set H,L to first visual line in logical line ; GTFRST: DEC L ;Look a line just above JR Z,GTFST1 ;If we're at top of screen, all done CALL GETTRM ;Get terminator JR Z,GTFRST ;More to get above in this logical GTFST1: INC L ;L=1ine number of first visual LD A,(FSTPOS) ;Get first line CP L ;Same? LD H,1 ;Assume not RET NZ ;Good assumption LD HL,(FSTPOS) ;Get first line and column RET ; ; Constants GRPDIF EQU 2000H ; ; Routines CHRGTR EQU 2686H DIOERR EQU 73B2H FILOU1 EQU 6C48H GETYPR EQU 2689H INIT EQU 2680H READYR EQU 409BH STOP EQU 63E6H SYNCHR EQU 2683H ; ; Workspace ASCPCT1 EQU 0F40BH ASCPCT2 EQU 0F40DH ATRBAS EQU 0F928H ATRBYT EQU 0F3F2H AUTFLG EQU 0F6AAH BAKCLR EQU 0F3EAH BASROM EQU 0FBB1H BDRCLR EQU 0F3EBH BRDATR EQU 0FCB2H BUF EQU 0F55EH BUFEND EQU 0FC18H BUFMIN EQU 0F55DH CAPST EQU 0FCABH CGPBAS EQU 0F924H CGPNT EQU 0F91FH CLIKFL EQU 0FBD9H CLIKSW EQU 0F3DBH CLOC EQU 0F92AH CLPRIM EQU 0F38CH CMASK EQU 0F92CH CNSDFG EQU 0F3DEH CODSAV EQU 0FBCCH CRTCNT EQU 0F3B1H CSAVEA EQU 0F942H CSAVEM EQU 0F944H CSRSW EQU 0FCA9H CSRX EQU 0F3DDH CSRY EQU 0F3DCH CSTYLE EQU 0FCAAH CURLIN EQU 0F41CH ENSTOP EQU 0FBB0H ESCCNT EQU 0FCA7H EXPTBL EQU 0FCC1H FNKFLG EQU 0FBCEH FNKSTR EQU 0F87FH FNKSWI EQU 0FBCDH FORCLR EQU 0F3E9H FSTPOS EQU 0FBCAH GETPNT EQU 0F3FAH GRPACX EQU 0FCB7H GRPACY EQU 0FCB9H GRPATR EQU 0F3CDH GRPCGP EQU 0F3CBH GRPCOL EQU 0F3C9H GRPHED EQU 0FCA6H GRPNAM EQU 0F3C7H GRPPAT EQU 0F3CFH HEADER EQU 0F40AH HIGH EQU 0F408H INSFLG EQU 0FCA8H INTCNT EQU 0FCA2H INTFLG EQU 0FC9BH INTVAL EQU 0FCA0H JIFFY EQU 0FC9EH KANAMD EQU 0FCADH KANAST EQU 0FCACH KEYBUF EQU 0FBF0H LINL32 EQU 0F3AFH LINL40 EQU 0F3AEH LINLEN EQU 0F3B0H LINTTB EQU 0FBB2H LOW EQU 0F406H LOWLIM EQU 0FCA4H LPTPOS EQU 0F415H MLTATR EQU 0F3D7H MLTCGP EQU 0F3D5H MLTNAM EQU 0F3D1H MLTPAT EQU 0F3D9H MUSICF EQU 0FB3FH NAMBAS EQU 0F922H NEWKEY EQU 0FBE5H NTMSXP EQU 0F417H OLDKEY EQU 0FBDAH OLDSCR EQU 0FCB0H ONGSBF EQU 0FBD8H PADX EQU 0FC9DH PADY EQU 0FC9CH PATBAS EQU 0F926H PATWRK EQU 0FC40H PLYCNT EQU 0FB40H PRTFLG EQU 0F416H PTRFIL EQU 0F864H PUTPNT EQU 0F3F8H QUEBAK EQU 0F971H QUEUEN EQU 0FB3EH QUEUES EQU 0F3F3H RAMLOW EQU 0F380H RAWPRT EQU 0F418H RDPRIM EQU 0F380H REPCNT EQU 0F3F7H REQSTP EQU 0FC6AH RG0SAV EQU 0F3DFH RG1SAV EQU 0F3E0H RUNFLG EQU 0F866H SAVSTK EQU 0F6B1H SCNCNT EQU 0F3F6H SCRMOD EQU 0FCAFH SFTKEY EQU 0FBEBH SLTTBL EQU 0FCC5H STATFL EQU 0F3E7H T32ATR EQU 0F3C3H T32CGP EQU 0F3C1H T32COL EQU 0F3BFH T32NAM EQU 0F3BDH T32PAT EQU 0F3C5H TRGFLG EQU 0F3E8H TRPTBL EQU 0FC4CH TTYPOS EQU 0F661H TXTCGP EQU 0F3B7H TXTNAM EQU 0F3B3H VCBA EQU 0FB41H VCBB EQU 0FB66H VCBC EQU 0FB8BH VOICAQ EQU 0F975H VOICEN EQU 0FB38H WINWID EQU 0FCA5H WORK1 EQU 0F866H WORK2 EQU 0F867H WORK3 EQU 0F869H WRPRIM EQU 0F385H ; ; Hooks H.CHGE EQU 0FDC2H H.CHPU EQU 0FDA4H H.DSPC EQU 0FDA9H H.DSPF EQU 0FDB3H H.ERAC EQU 0FDAEH H.ERAF EQU 0FDB8H H.FORM EQU 0FFACH H.INIP EQU 0FDC7H H.INLI EQU 0FDE5H H.ISFL EQU 0FEDFH H.KEYC EQU 0FDCCH H.KEYI EQU 0FD9AH H.KYEA EQU 0FDD1H H.LPTO EQU 0FFB6H H.LPTS EQU 0FFBBH H.NMI EQU 0FDD6H H.OUTD EQU 0FEE4H H.PHYD EQU 0FFA7H H.PINL EQU 0FDDBH H.QINL EQU 0FDE0H H.TIMI EQU 0FD9FH H.TOTE EQU 0FDBDH END