home *** CD-ROM | disk | FTP | other *** search
-
- ; 13 May 85
-
- ;**
- ;** 80 COLUMN FUNCTION CODE
- ;**
-
- fixed$8563 equ false
-
- ;*
- ;* Write character in D to current cursor address
- ;* Advance cursor next position
- ;*
- wr$char$80:
- lhld char$adr
- call write$char$80
- lda char$col ; get cursor column number
- cpi 80-1
- jrz do$crlf
- inr a
- sta char$col ; update column number
- lhld char$adr ; get cursor address
- inx h
- shld char$adr ; update cursor address
-
- ;
- ; input:
- ; HL=current cursor address
- ;
- set$cursor:
- mvi a,14 ;
- call wait ;
- outp h
- mvi a,15 ;
- call wait ;
- outp l
- ret
-
- page
-
-
- ;*
- ;* Set current ROW and COL (supplied in DE)
- ;*
- ;*
- crs$pos$80:
- mov a,d
- cpi 25
- rnc
- mov a,e
- cpi 80
- rnc
- xchg ; cursor row # in D,column # in C
- shld char$col
-
- ;
- ; returns with cursor set and current ROW, COLUMN in BC
- ; and character screen address in HL
- ;
- compute$adr:
- lhld char$col
- call cur$adr$hl ; HL=cursor address on return
- shld char$adr
- jr set$cursor ; call/ret
-
- page
- ;*
- ;* Move cursor up one line; do nothing if on the
- ;* top line
- ;*
- crs$up$80:
- lda char$row
- ora a
- rz
- dcr a
- set$row$80:
- sta char$row
- jr compute$adr
-
-
- do$crlf:
- xra a
- sta char$col
-
- ;*
- ;*
- ;*
- ;*
- crs$down$80:
- lda char$row
- cpi lines-1 ; on bottom line ?
- jrz scroll$up ; yes, scroll the screen
- jrnc set$24$80 ; past it, set it to line 24
- inr a
- jr set$row$80
-
- ;*
- ;*
- ;*
- ;*
- crs$left$80:
- lda char$col
- ora a
- rz
- dcr a
- set$col$80:
- sta char$col
- jr compute$adr
-
- page
- ;*
- ;*
- ;*
- ;*
- crs$rt$80:
- lda char$col
- inr a
- cpi 80
- jrnz set$col$80
- ret
-
- ;*
- ;*
- ;*
- ;*
- crs$cr$80:
- xra a
- jr set$col$80
-
- page
- ;
- ;
- ;
- set$24$80:
- mvi a,lines-1
- sta char$row
- ;
- ;
- ;
- scroll$up:
- lxi h,80
- lxi d,0
- lxi b,80*(lines-1)
- call block$move$80
-
- ;
- ;
- ;
- clear$bottom$line:
- lxi h,80*(lines-1)
- lxi b,80
- call block$fill$space$80
- jr compute$adr
-
- page
- ;*
- ;* B= bit position to set or clear
- ;* C= new bit value
- ;*
- ;* attr byte def. (in B and C)
- ;* bit 7-alternate char set (uper case set)
- ;* bit 6-reverse video
- ;* bit 5-underline
- ;* bit 4-blink
- ;* bit 0-full intensity
- ;*
- ;*
- set$attr$80:
- lda current$atr
- cma ; invert A
- ora b ; force new bit to 1
- cma ; restore A
- ora c
- sta current$atr
- ret
-
- page
- ;*
- ;* ASCII codes(B) 20h to 2Fh set character color
- ;* 30h to 3Fh set background color
- ;* 50h to 5Fh set logical character color
- ;* 60h to 6Fh set logical background color
- ;* all others code do nothing
- ;*
- ;*
- set$color$80:
- mov a,b ; get color to A
- sui 20h ; remove the BIAS
- cpi 20h ; physical color ? (00h-1Fh)
- jrc ?col$80 ; yes, go set it
- mvi c,20h ; max color value+1 (00h-1Fh)
- call lookup$color$1 ; convert char in A to color (ret in A)
- ; C=max color character
- rc ; return if error
- mov a,m ; get color bytes
- ani 0fh ; LSB is 80 column color
- add b ; Add color offset back
- ; 0-f set forground color
- ; 10-1f set background color
-
- page
- ;
- ; set color in A (00-0F sets the character color)
- ; (10-1F sets the background color)
- ;
- ; This routine first calls lookup color to convert the 40 column
- ; color (normal color) to the 80 column RGBI color
- ;
- ?col$80:
- sta temp1
- mvi c,20h ; max color value+1 (00h-1Fh)
- adi 30h ; restore a bias
- lxi h,color$convert$tbl ; table to use
- call lookup$color$2 ; convert to same color as 40 Column
- mov a,m ; get character color
- add b ; add color offset back
-
- cpi 10h ; character color? (0-f)
- jrc chr$col$80 ; yes, go do it
- ; no, fall thru and set background
- ;
- ; set background color (10-1F)
- ;
- ani 0Fh ; get value of 0 to F
- sta bg$color$80
- push psw
- mvi a,26 ; color register
- call wait
- pop psw
- outp a
- ret
-
- ;*
- ;*
- ;*
- rd$color$80:
- lda bg$color$80
- mov b,a
- lda current$atr
- mov d,a
- lda char$color$80
- ret
-
- page
- ;
- ; set character color
- ;
- chr$col$80:
- mov b,a
- lda current$atr
- ani 0f0h ; remove old color
- ora b ; merge new color
- sta current$atr ; save new attr
- lda temp1
- sta char$color$80
- ;
- ; set current char position color to new color
- ;
- lhld char$adr ; get current cursor adr
- lxi d,800h ; offset to attr
- dad d ; pointing to current char attr
- call set$update$adr ; point to attr byte
- lda current$atr
- outp a
- ret
-
- page
- ;*
- ;*
- ;*
- ;*
- CEL$80:
- call cur$adr$80$hl$sz$a ; HL=cur adr, DE=line start adr
- ; BC=count to move, A=BC+1
- inx b ; 1 to 80 to fill
- jr cont$space$fill
-
-
- ;*
- ;*
- ;*
- ;*
- CES$80:
- call cur$adr$80$hl$sz$a ; HL=cur adr, DE=line start adr
- ; BC=count to move, A=BC+1
- xchg ; cursor address in DE
- lxi h,lines*80
- xra a ; clear the carry
- dsbc DE ; count will be minus if on status line
- rm ; return if on status line
- mov b,h
- mov c,l ; count to BC
- xchg ; cursor address back to HL
-
- cont$space$fill:
- jmp block$fill$space$80
-
- page
- ;*
- ;*
- ;*
- char$ins$80:
- call cur$adr$80$hl$sz$a ; HL=cur adr, DE=line start adr
- ; BC=count to move, A=BC+1 (1-80)
- lxi h,80-1
- dad d ; point to end of line
- dcr a ; A=1 if at end of line
- jrz char$ins$80$end
- mov d,h
- mov e,l ; HL=DE= end of line address
- dcx h ; [HL--] -> [DE--] count BC
-
- push b
- push h
- push d
- call insert$low
- lxi b,800h ; attribute offset
- pop h
- dad b
- xchg
- pop h
- dad b
- pop b
-
- insert$low:
- push b
- call set$update$adr
- inp a
- xchg
- push psw
- call set$update$adr
- pop psw
- outp a
- xchg
- pop b
- dcx h
- dcx d
- dcx b
- mov a,b
- ora c
- jrnz insert$low
-
- lhld char$adr
-
- char$ins$80$end:
- jmp write$space$80
-
- page
- ;*
- ;*
- ;*
- ;*
- char$del$80:
- call cur$adr$80$hl$sz$a ; HL=cur adr, DE=line start adr
- ; BC=count to move, A=BC+1
- push d ; save line start address
- mov d,h
- mov e,l ; DE=HL=cursor address
- inx h ; [HL++]->[DE++] count BC
- call block$move$80 ; DE points to last position
-
- pop h ; recover line start address
- lxi d,80-1
- dad d ; point to end of line
- jmp write$space$80
-
- page
- ;*
- ;*
- ;* Moves one line at a time, down one line, starting with the next
- ;* to the bottom line. Once the cursor line is moved down, the
- ;* cursor line is cleared.
- ;*
- line$ins$80:
- lxi d,new$offset
- mvi a,lines-1 ; cursor on or past the last line ?
- lhld char$col
- cmp h
- jz clear$bottom$line ; no bottom, clear bottom line
- jrc line$ins$cont ; past,
- lxi h,(lines-2)*80
- lxi d,(lines-1)*80
- mvi b,lines
- move$next$down:
- call move$line$down
- lda char$row
- cmp b
- jrnz move$next$down
-
- call cur$adr$80$hl$sz$a ; HL=cur adr, DE=line start adr
- ; BC=count to move, A=BC+1
- xchg ; get line start adr
- lxi b,80
- jr block$fill$space$80
-
- ;
- ;
- ;
- line$ins$cont:
- inr a
- cmp l
- rnz
- jmp update$it
-
- page
- ;
- ; INPUT:
- ; HL=source
- ; DE=dest
- ; B=line number
- ; OUTPUT:
- ; HL=source-80
- ; DE=dest-80
- ; B=line number - 1
- ;
- move$line$down:
- push b
- push h
- push d
- lxi b,80
- call block$move$80
- lxi b,-80
- pop h
- dad b
- xchg
- pop h
- dad b
- pop b
- dcr b
- ret
-
- page
- ;*
- ;*
- ;*
- line$del$80:
- lda char$row
- cpi lines ; is the cursor past the bottom line ?
- rnc ; yes, exit
- call cur$adr$80$hl$sz$a ; HL=cur adr, DE=line start adr
- ; BC=count to move, A=BC+1
- lxi h,80 ; line length
- dad d ; HL=start of next line
- xchg ; move from address in DE
- push h ; save TO address
- lxi h,lines*80
- xra a ; clear the carry
- dsbc DE
- mov b,h
- mov c,l ; count to BC
- pop h ; recover TO address
- xchg ; move from address back to HL
-
- call block$move$80 ; DE points to last position
- jmp clear$bottom$line
-
- page
- ;
- ; user interface point
- ;
- blk$fill:
- pop h ; get the return addres
- xthl ; get HL, ret adr to stack.
- jr block$fill$80
- ;
- ; INPUT:
- ; HL=start address
- ; BC=count
- ;
- block$fill$space$80:
- lda current$atr
- mov e,a
- mvi d,' '
- ;
- ; 80 block fill
- ;
- ; INPUT:
- ; HL=start address
- ; BC=count
- ; D=fill character, E=attribute
- ;
- block$fill$80:
- mov a,b ; get MSB of count to A
- ana a ; is it zero
- jrz fill$less$256 ; yes, move less than 256 bytes
- block$fill$cont$80:
- push h
- push d
- push b
- xra a
- call fill$data$80
- pop b
- pop d
- pop h
- inr h
- djnz block$fill$cont$80
-
- page
- ;
- ;
- ;
- fill$less$256:
- mov a,c ; get LSB of count to A
- ana a ; is it zero ?
- rz ; yes, none left to fill, return
- ;
- ; count in A (1 to 256) (0=256)
- ; HL=fill adr
- ; DE=fill character, and attribute
- ;
- fill$data$80:
- push psw ; save count
- push h ; save adr
- push d ; save fill character
- call fill$half$80
- pop d ; recover fill character
- lxi b,800h ; offset to attributes
- pop h ; recover adr
- dad b ; HL=attr adr
- call do$twice?
- pop psw ; recover count
- mov d,e ; get the attr to D
-
- page
- ;
- ;
- fill$half$80:
- push psw ; save the count
- call set$update$adr ; write address to chip R18,R19
- outp d ; write update data (R31)
-
- pop psw
- dcr a ; already wrote one above
- rz ; return if only one required
- push psw
-
- mvi a,24
- call wait
- inp a ; get old value in reg 24
- ani 7fh
- outp a ; clear R24(7), enabling block writes
-
- mvi a,30
- call wait
- pop psw ; recover the count
- outp a ; write count to R30
- if fixed$8563
- ret
- else
- mvi b,0
- mov c,a
- inx b ; add back the one removed above
- dad b
- push d ; save fill char (in D)
- push h ; HL=end address
-
- mvi a,18
- call wait
- inp h
- mvi a,19
- call wait
- inp l ; HL=current pointer
-
- pop d ; DE=end adr
- pop b ; get fill char (to B)
- finish$fill:
- call cmp$HL$DE ; compare dest with chip dest
- ; HL<DE carry is set
- rnc ; return if done
-
- push b ; save fill char
- call set$update$adr ; HL&DE NOT changed (BC&A changed)
- pop b ; recover fill char
- outp b
- inx h ; add one to dest pointer
- jr finish$fill
-
- endif
-
- page
- ;
- ; user entry point return adr on top of stack
- ; and HL next
- ;
- blk$move:
- pop h ; get return adr
- xthl ; get HL save ret adr
- ;
- ; block move 80 column chip memory
- ;
- ; INPUT:
- ; HL=source
- ; DE=dest
- ; BC=count
- ;
- block$move$80:
- mov a,b ; get MSB of count to A
- ana a ; is it zero
- jrz move$less$256 ; yes, move less than 256 bytes
- block$move$cont$80:
- push h
- push d
- push b
- xra a
- call move$data$80
- pop b
- pop d
- pop h
- inr h
- inr d
- djnz block$move$cont$80
-
- move$less$256:
- mov a,c ; get LSB of count to A
- ana a ; is it zero ?
- rz ; yes, none left to move, return
-
- page
- ;
- ; count in A (1 to 256) (0=256)
- ; HL=source
- ; DE=dest
- ;
- move$data$80:
- xchg ; HL=dest DE=source
- push psw ; save count
- push h ; save dest
- push d ; save source
- call move$half$80
- lxi b,800h ; offset to attributes
- pop h ; recover source addr
- dad b ; make attr source
- xchg ; DE=attr source
- pop h ; recover dest
- dad b ; HL=attr dest
- call do$twice?
- pop psw ; recover count
-
- ;
- ;
- move$half$80:
- push psw ; save the count
- call set$update$adr ; write dest address to chip R18,R19
-
- mvi a,24
- call wait
- inp a ; get old value in reg 24
- ori 80h
- outp a ; set R24(7), enabling block copy
-
- ; call set$source$adr ; write source address (R32,R33=DE)
- ;set$source$adr:
- mvi a,32
- call wait
- outp d
- mvi a,33
- call wait
- outp e
- ; ret
-
- mvi a,30
- call wait
- pop psw ; recover the count
- outp a ; write count to R30
- ret
-
- page
-
- ;
- ;
- ;
- do$twice?:
- mov a,h ; HL=video memory address
- cpi DS$char$def/256 ; Char def area?
- rc ; no, return, must be char, attr area
- pop psw ; remove return adr
- pop psw ; remove old A and psw
- ret ; return to org caller
-
- page
- ;
- ;
- ;
- write$space$80:
- mvi d,' '
- write$char$80:
- lda current$atr
-
- ;
- ; HL=cursor adr, D=char to write, A=attr to write
- ;
- write$memory:
- push h
- push d ; save character
- lxi d,800h ; offset to attribrute
- dad d
- mov d,a
- call wr$mem
- pop d
- pop h
-
- wr$mem:
- call set$update$adr
- outp d
- ret
-
- ;*
- ;* input:
- ;* D=Char ROW, E=Char COLUMN
- ;* output:
- ;* B=Char, C=attribute (true RGBI color)
- ;*
- rd$chr$80:
- call crs$pos$80
- lhld char$adr
- call read$memory
- mov c,a ; attr was in A
- ret
-
- ;*
- ;* input:
- ;* D=Char ROW, E=Char COLUMN
- ;* B=Char, C=attribute (true RGBI color)
- ;* output:
- ;*
- wr$chr$80:
- push b ; save Char and attr
- call crs$pos$80
- lhld char$adr
- pop b ; recover Char and attr
- mov d,b ; char to D
- mov a,c ; attr to A
- jr write$memory ; write char and attr to memory
-
- ;
- ;
- ;
- read$memory:
- push h
- lxi d,800h ; offset to attribute
- dad d
- call rd$mem
- mov a,b
- pop h
- ;
- ;
- rd$mem:
- push psw
- call set$update$adr
- pop psw
- inp b
- ret
-
- page
- ;
- ;
- ;
- wait:
- push psw
- lxi b,0d600h ; point to adr register
- wait$loop:
- inp a ; check if chip is ready yet
- ral ; (MSB=1 when ready)
- jrnc wait$loop ; not ready, loop
- pop psw
- outp a ; set chip register
- inr c ; point to data register
- ret
-
- ;
- ;
- ;
- set$update$adr:
- mvi a,18
- call wait
- outp h
- mvi a,19
- call wait
- outp l
- mvi a,31
- call wait
- dcr c
-
- update$wait:
- inp a
- ral
- jrnc update$wait
- inr c
- ret
-
- page
- ;**
- ;** 40 COLUMN TERMINAL FUNCTION CODE
- ;**
- ;**
-
- ;*
- ;*
- ;*
- wr$char$40:
- mov b,d
- call ascii$to$petascii ; convert to pet ASCII
- lhld char$adr$40
- mov b,a
- lda rev$40
- ora b
- mov m,a
- inx h
- shld char$adr$40
- lxi d,800h-1
- dad d ; point to attribute byte
- lda attr$40 ; get current attribute
- mov m,a ; set it
-
- lda char$col$40
- cpi 80-1 ; at end of line?
- jrz crlf$40 ; yes, do crlf
- inr a
- sta char$col$40 ; move cursor right
- jmp set$cursor$40 ; set cursor & paint the current ROW
-
- page
- ;*
- ;* input:
- ;* D=Char ROW, E=Char COLUMN
- ;* output:
- ;* H=Char ROW, L=Char COLUMN
- ;* B=Char, C=attribute (40 col attr and color)
- ;*
- rd$chr$40:
- call crs$pos$only$40
- lhld char$adr$40
- mov b,m
- lxi d,800h
- dad d
- mov c,m
- ret
-
- ;*
- ;* input:
- ;* D=Char ROW, E=Char COLUMN
- ;* B=Char, C=attribute (40 col attr and color)
- ;* output:
- ;* H=Char ROW, L=Char COLUMN
- ;*
- wr$chr$40:
- push b
- call crs$pos$only$40
- pop b
- lhld char$adr$40
- mov a,b
- ani 7fh ; remove reverse video bit
- bit 6,c
- jrz not$rev$vid$bit
- adi 80h ; set reverse video
- not$rev$vid$bit:
- mov m,a
- lxi d,800h
- dad d
- mov m,c
- jmp set$cursor$40
-
-
- ;*
- ;*
- ;*
- crs$pos$40:
- lxi h,old$offset
- setb 6,m ; force page paint
- crs$pos$only$40:
- mov a,d
- cpi 25
- rnc
- mov a,e
- cpi 80
- rnc
- xchg
- shld char$col$40
- ;
- ;
- ;
- compute$adr$40:
- lhld char$col$40
- call cur$adr$hl ; HL=cursor adr relative to zero
- lxi d,screen$40 ; get screen offset
- dad d ; true cursor address
- shld char$adr$40
- jmp set$cursor$40
-
- page
- ;*
- ;*
- ;*
- ;*
- crs$up$40:
- lda char$row$40
- ora a
- rz
-
- dcr a
- set$row$40:
- sta char$row$40
- cont$compute$adr$40:
- lxi h,old$offset
- setb 6,m
- jr compute$adr$40
-
- ;
- ;
- ;
- crlf$40:
- xra a
- sta char$col$40
- ;*
- ;*
- ;*
- ;*
- crs$down$40:
- lda char$row$40
- cpi lines-1
- jrz scroll$up$40
- jrnc set$24$40
- inr a
- jr set$row$40
-
- page
- ;
- ;
- ;
- set$24$40:
- mvi a,lines-1
- sta char$row$40
- ;
- ;
- ;
- scroll$up$40:
- lxi h,screen$40+80
- lxi d,screen$40
- lxi b,80*(24-1)
- ldir ; move characters up one line
-
- xchg ; get start of last line in HL
- lxi d,screen$40+80*23+1
- lxi b,80-1
- call space$fill$40 ; clear the bottom line
-
- lxi h,screen$40+800h+80
- lxi d,screen$40+800h
- lxi b,80*(lines-1)
- ldir ; move attributes up one line
-
- xchg ; get start of last line in HL
- lxi d,screen$40+800h+80*23+1
- lxi b,80-1
- lda attr$40
- mov m,a
- ldir ; set color attribute
- jr cont$compute$adr$40
-
- page
- ;*
- ;*
- ;*
- ;*
- crs$left$40
- lda char$col$40
- ora a
- rz
-
- dcr a
- set$col$40:
- sta char$col$40
- jr compute$adr$40
-
- ;*
- ;*
- ;*
- ;*
- crs$rt$40:
- lda char$col$40
- inr a
- cpi 80
- jrnz set$col$40
- ret
-
- ;*
- ;*
- ;*
- ;*
- crs$cr$40:
- xra a
- jr set$col$40
-
- page
- ;*
- ;*
- ;*
- ;*
- CEL$40:
- lxi h,line$paint
- push h
- call cur$adr$40$hl$sz$a ; HL=cursor adr, DE=start of line adr
- ; BC=DE+80-HL-1, A=BC+1 (1-80)
- lxi d,screen$40 ; get start of screen
- dad d ; HL=cursor position in memory
- call write$space$40 ; place a space at the cursor adr
- mov a,c
- ana a
- rz
- push b
- push h
- mov d,h
- mov e,l ; DE=HL=cursor pos
- inx d ; point to next location
- ldir ; BC=count (0-79)
- jr clear$attr$also
-
- page
- ;*
- ;*
- ;*
- ;*
- CES$40:
- lxi h,screen$paint
- push h
- lxi d,screen$40+80*lines-1 ; DE=end of screen
- lhld char$adr$40 ; clear from char$adr to DE
- xchg
- xra a ; clear the carry bit
- DSBC DE ; result is minus if on status line
- rm ; return if on status line
-
- xchg
- jrz write$space$40 ; at end, clear cursor position
-
- mov b,d
- mov c,e ; count in BC
- mov d,h
- mov e,l ; start adr in HL
- inx d ; start adr+1 in DE
- push b ; save number of bytes to move
- push h ; save start address
- call space$fill$40 ; move space thru screen
- ;
- ;
- ;
- clear$attr$also:
- lxi b,800h
- pop h
- dad b ; 1st attribute
- pop b ; get the count
- mov d,h
- mov e,l
- inx d ; 2nd attribute
- lda attr$40
- mov m,a
- ldir ; move current attribute to screen
- ret
-
- page
- ;*
- ;*
- ;*
- ;*
- char$ins$40:
- lxi h,line$paint
- push h
- call cur$adr$40$hl$sz$a ; HL=cur adr, DE=line start adr
- ; BC=count to move, A=BC+1 (1-80)
- lxi h,screen$40-1+80
- dad d ; point to end of current line
- dcr a ; at right end of screen ?
- jrz write$space$40 ; yes, insert a space
- mov d,h
- mov e,l ; HL=DE= end of line address
- dcx h ; [HL--] -> [DE--] count BC
- push b
- push d
- lddr ; DE=cursor position
- xchg
- call write$space$40 ; write a space at the cursor adr
- pop h
- lxi b,800h ; now move the attributes
- dad b
- pop b
- mov d,h
- mov e,l ; HL=DE= end of line address
- dcx h ; [HL--] -> [DE--] count BC
- lddr ; DE=cursor position
- ret
-
- ;
- ;
- ;
- write$space$40:
- lda rev$40
- adi ' ' ; clear character, enable cursor
- mov m,a
- ret
-
- page
- ;*
- ;*
- ;*
- ;*
- char$del$40:
- lxi h,line$paint
- push h
- call cur$adr$40$hl$sz$a ; HL=cur adr, DE=line start adr
- ; BC=count to move, A=BC+1
- lxi d,screen$40
- dad d ; point to screen memory location
-
- dcr a ; at end of line ?
- jrz write$space$40 ; yes, then just erase cursor pos
-
- mov d,h
- mov e,l ; DE=HL=cursor address
- push b
- push h
- inx h ; [HL++]->[DE++] count BC
- ldir ; DE points to last position
- xchg
- call write$space$40 ; place a space at the end of line
- pop h
- lxi b,800h+1 ; now move the attributes
- dad b
- pop b
- mov d,h
- mov e,l ; HL=DE= cursor attr address
- inx h ; [HL++] -> [DE++] count BC
- ldir ;
- ret
-
- page
- ;*
- ;*
- ;*
- ;*
- line$ins$40:
- lxi h,screen$paint
- push h
- lda char$row$40
- cpi lines-1
- jrz clear$bottom$line$40
- rnc ; return if on status line
- call cur$adr$40$hl$sz$a ; HL=cur adr, DE=line start adr
- ; BC=count to move, A=BC+1
- lxi h,screen$40
- dad d ; point to line start memory location
- push h ; save start address
- lxi d,80
- dad d ; point to start of next line
-
- xchg ; cursor line(+1) start address in DE
- lxi h,screen$40+80*lines ; end of screen address
- xra a ; clear the carry bit (and A)
- dsbc DE ; HL=HL-DE
- mov b,h
- mov c,l ; count in
-
- lxi h,screen$40+80*(lines-1)-1 ; HL=end of screen-80
- lxi d,screen$40+80*lines-1 ; DE=end of screen
-
- push b
- lddr
-
- page
-
- pop b
- lxi h,screen$40+80*(lines-1)-1+800h
- lxi d,screen$40+80*lines-1+800h
- lddr ; scroll the attributes
- pop h ; get cursor line start address
- mov d,h
- mov e,l
- inx d
- lxi b,80-1
- jr space$fill$40
-
- ;
- ;
- ;
- clear$bottom$line$40:
- lxi h,screen$40+(lines-1)*80
- lxi d,screen$40+(lines-1)*80+1
- lxi b,80-1
- space$fill$40:
- lda rev$40
- adi ' '
- mov m,a
- ldir
- ret
-
- page
- ;*
- ;*
- ;*
- ;*
- line$del$40:
- lxi h,screen$paint
- push h
- lda char$row$40
- cpi lines-1 ; on or past last line ?
- jrz clear$bottom$line$40 ; on, just clear it
- rnc ; past it, return
-
- call cur$adr$40$hl$sz$a ; HL=cur adr, DE=line start adr
- ; BC=count to move, A=BC+1
- lxi h,screen$40
- dad d ; point to line start memory location
- push h ; save cursor line start adr
- lxi d,80
- dad d ; point to start of next line
-
- xchg ; cursor line(+1) start address in DE
- lxi h,screen$40+80*lines ; end of screen address
- xra a ; clear the carry bit (and A)
- dsbc DE ; HL=HL-DE
- mov b,h
- mov c,l ; count in
-
- xchg ; HL=start of line after cursor line
- pop d ; start of cursor line
-
- push b ; save count
- push h ; save source
- push d ; save dest
- ldir
-
- lxi b,800h ; get attribute offset
- pop h ; recover dest
- dad b ; attr dest
- xchg ; dest belongs in DE
- pop h ; recover source
- dad b ; attr source
- pop b ; recover count
- ldir
- jr clear$bottom$line$40
-
- page
- ;*
- ;* B=bits to set or clear
- ;* C=bits new value
- ;*
- ;* attr byte def. (in B)
- ;* bit 7-
- ;* bit 6-reverse video *
- ;* bit 5-underline
- ;* bit 4-blink
- ;* bit 0-full intensity (masked off)
- ;*
- ;*
- set$attr$40:
- mov a,b
- ani 070h
- mov b,a
-
- mov a,c
- ani 070h
- mov c,a
-
- lda attr$40
- cma
- ora b
- cma ; bits in B cleared A
- ora c ; add new value
- sta attr$40
- ral ; get reverse attr in bit 7
- ani 80h
- sta rev$40
- ret
-
- page
- ;*
- ;* ASCII codes 20h to 2Fh set character color
- ;* 30h to 3Fh set background color
- ;* 40h to 4Fh set border color
- ;* 50h to 5Fh set locical character color
- ;* 60h to 6Fh set logical background color
- ;* 70h to 7Fh set logical border color
- ;* all others code do nothing
- ;*
- ;* All colors are assigned from color lookup table
- ;*
- set$color$40:
- mov a,b
- sui 20h
- cpi 30h
- jrc ?col$40
- mvi c,30h ; max color value+1 (00h-2Fh)
- call lookup$color$1 ; HL points to table entry on ret
- rc ; exit if error
- mov a,m ; get table value again
- rrc
- rrc
- rrc
- rrc ; get upper 4 bits to lower
- ani 0fh
- add b ; get old MSB
-
- ?col$40:
- cpi 10h ; character color? (0-f)
- jrc char$color$40 ; yes, go do it
- ; no, fall thru test background, border
- cpi 20h ; background color? (10-1f)
- jrc back$color$40 ; yes, go do it
- ; no, fall thru and set border color
- ;
- ; set border color
- ;
- ani 0fh ; color from 0-f
- sta bd$color$40
- lxi b,VIC+32
- outp a
- ret
-
- page
- ;
- ; set background color (10-1F)
- ;
- back$color$40:
- ani 0Fh ; get value of 0 to F
- sta bg$color$40
- lxi b,VIC+33
- outp a
- ret
-
- ;*
- ;*
- ;*
- rd$color$40:
- lda bg$color$40
- mov b,a
- lda bd$color$40
- mov c,a
- lda attr$40
- mov d,a
- ani 0fh
- ret
-
- ;
- ; set character color
- ;
- char$color$40:
- mov b,a
- lda attr$40
- ani 0f0h
- ora b
- sta attr$40
-
- lhld char$adr$40
- lxi d,800h
- dad d
- mov m,a
- ; jmp line$paint
-
- page
- ;
- ;
- ;
- line$paint:
- lda old$offset
- mov b,a
- ora a
- cm trk$40
-
- lda @off40 ;
- cmp b
- sta old$offset
- jrnz screen$paint
-
- call cur$adr$40$hl$sz$a ; DE=start of row adr (REL)
- lxi h,screen$40 ; get start of screen
- dad d ; HL=row start address (ABS)
- xchg ; save in DE
- lhld @off40 ; get current screen offset (0-39)
- dad d ; screen source adr in HL
- push h ; save for later
-
- lda char$row$40 ; get current row #
- mov l,a ; HL=row # (H=0)
- call Lx40$plus$VIC
- xchg ; place screen adr (25X40) in DE
- pop h ; recover logical screen adr (25X80)
-
- push h ; save for attr move
- push d
-
- mvi a,1 ; one line only
-
- call update$window$fun
- pop h ; recover screen pointer (25X40)
- lxi b,vic$color-vic$screen
- dad b ; point to Vic color memory
- xchg ; DE=color memory pointer
- pop h ; recover screen pointer (25X80)
- lxi b,800h ; offset to attributes
- dad b
- mvi a,1 ; one line only
- jr update$window$fun ;
-
- page
- ;
- ; hl=offset (0 to 39)
- ;
- screen$paint:
- lhld @off40
- lda paint$size ; number of lines to move
- push h
- push psw ; save the count
-
- lxi d,screen$40
- dad d ; point to start of visible screen
- lxi d,vic$screen ; place to move it to
- call update$window$fun
-
- pop psw
- pop h
- lxi d,screen$40+800h
- dad d ; add the screen offset
- lxi d,vic$color
- ;
- ; Always called from bank 0, Placed in common so that IO
- ; will not overlay this code. Can go in ROM
- ;
- update$window$fun:
- sta io$0
- update$window$loop:
- lxi b,40 ; number of bytes to move
- ldir
- push d
- lxi d,80-40 ; advance pointer to next line
- dad d
- pop d
- dcr a
- jrnz update$window$loop
-
- sta bank$0
- ret
-
-
- page
- ;
- ;
- ;
- trk$40:
- lda char$col$40 ; get the current column number
- sui 40-8 ; remove 1st 32 columns
- jrnc use$offset ; if pass column 32, set an offset
- xra a
- use$offset:
- ani 0f8h ; move
- sta @off40
- ret
-
- page
- ;
- ;
- ;
- set$cursor$40:
- call no$cursor
- call line$paint ; will do a screen paint if required
-
- lda @off40 ; get screen offset
- mov b,a ; save offset (0 to 39)
- lhld char$col$40 ; H=row, L=col
- mov a,l ; get col # in A
- sub b ; remove offset
- jrc no$cursor
- cpi 40
- jrnc no$cursor
- mov c,a
- mvi b,0 ; BC=cursor column #
- mov l,h ; get row # in L
- call Lx40$plus$VIC
- dad b
- jr set$flash
- ;
- no$cursor:
- lxi h,0 ; if H=0 (L=xx) then cursor off
- ;
- set$flash:
- shld flash$pos
- ret
-
- page
- ;
- ;
- ;
- Lx40$plus$VIC:
- mvi h,0
- dad h ; 2X
- dad h ; 4X
- dad h ; 8X
- mov d,h
- mov e,l ; DE=8X
- dad h ; 16X
- dad h ; 32X
- dad d ; 8X+32X=40X
- lxi d,vic$screen
- dad d ; point to screen area
- ret
-
- page
- ;
- ; input:
- ; range 20h to 7fh in B
- ; output:
- ; in A
- ;
- ascii$to$petascii:
- mov a,b
- cpi 40h
- jrz is40 ; get at sign
- rc ; ret if code was 20h - 3fh
-
- cpi 'Z'+1 ; is it an upper case letter ?
- rc ; yes, code was 41h - 5Ah
-
- sui 40h
- cpi 60h-40h
- jrz was$60 ; 60h converted to 27h
-
- jrc was$5b$to$5f
-
- sui 20h
- cpi 'z'+1-60h
- rc ; code was 61h - 7Ah
-
- cpi '{'-60h
- jrz is$left$brace
- cpi '|'-60h
- jrz is$vert$bar
- cpi '}'-60h
- jrz isright$brace
- cpi '~'-60h
- rnz
- mvi a,64 ; commodore horz bar
- ret
-
- was$60:
- mvi a,126 ; solid upper left corner
- ret
-
- is$left$brace:
- mvi a,115 ;
- ret
-
- is$vert$bar:
- mvi a,93 ; commodore vertical bar
- ret
-
- is$right$brace:
- mvi a,107 ;
- ret
-
- was$5b$to$5f:
- cpi '\'-40h
- jrz is$back$slash
- cpi '_'-40h
- rnz
- mvi a,100 ; commodore under line
- ret
-
- is$back$slash:
- mvi a,127 ; upper left and lower right corners
- ret
-
- is40:
- xra a
- ret
-
- page
- ;
- ;
- ;
- cur$adr$40$hl$sz$a:
- lhld char$col$40
- jr cur$adr$hl$sz$a
- ;
- ;
- ;
- cur$adr$80$hl$sz$a:
- lhld char$col
-
- ;
- ; INPUT:
- ; H=row L=col
- ;
- ; OUTPUT:
- ; HL=cursor address
- ; DE=cursor line start address
- ; BC=# character to end of line ( <80 )
- ; (not counting the cursor position)
- ; A=BC+1
- ;
- cur$adr$hl$sz$a:
- mvi a,80-1 ; get line length
- sub l ; A=
- mov c,a
-
- cur$adr$hl:
- mov b,l ; save column #
- mov l,h
- mvi h,0 ; HL=row #
- dad h ; 2x
- dad h ; 4x
- dad h ; 8x
- dad h ; 16x
- mov d,h
- mov e,l ; save 16x
- dad h ; 32x
- dad h ; 64x
- dad d ; 64x+16x=80x
- xchg ; DE=row start address
- mov l,b ; get saved column #
- mvi h,0 ; HL=column #
- dad d ; HL=cursor address
-
- mvi b,0 ; BC= count (if call to cur$adr$hl$sz$a:)
- inr a ; number of bytes to end of line (1-80)
- ret
-
- page
- ;
- ; destroys DE,HL,B,A
- ;
- lookup$color:
- mov a,b ; color supplied in B
-
- lookup$color$1:
- lhld color$tbl$ptr
- ;
- ; HL=table adr
- ; A= color input
- ; C= max allowable color value
- ;
- lookup$color$2:
- sui 30h ; remove bias
- rc
- cmp c ; above limit
- cmc
- rc ; yes, return input out-of-range
- mov b,a ; save adjusted color #
- ani 0fh ; get only the color #
-
- mov e,a
- mvi d,0
- dad d ; get converted color address
- mov a,b ; get the ASCII char back
- ani 30h ; keep only char/background/borber bits
- mov b,a ; save char/background bit
- ret
-
- page
- ;
- ;
- ;
- bell:
- lxi b,sid+24
- lhld sound$1
- outp h
- mvi c,5
- outp l
-
- lhld sound$2
- inr c
- outp h
- mvi c,1
- outp l
-
- lhld sound$3
- mvi c,4
- outp h
- outp l
- ret
-