;--------------------------------------------------------------------- .importzp ptr1, ptr2, ptr3, ptr4, sreg .importzp sp .import pushax .import incsp2 .import _ctk_80col_screencolors .import _ctk_80col_screenpattern .import _ctk_80col_lefttab .import _ctk_80col_righttab .import _ctk_80col_cursx .import _ctk_80col_cursy .import _ctk_80col_color .import _ctk_80col_underline .import _ctk_80col_reversed .import _ctk_80col_yscreenaddr .import _ctk_80col_yhiresaddr .import _ctk_80col_windowparams .import _ctk_80col_bitmapptr .import _ctk_80col_versionstring .import _ctk_80col_versionstring_len .import _ctk_80col_theme .export _ctk_80col_cclear .export _ctk_80col_chline .export _ctk_80col_cputc .export _ctk_80col_cputsn .export _ctk_80col_clear_line .export _ctk_80col_draw_bitmapline .export _ctk_80col_draw_windowborders ;--------------------------------------------------------------------- ptr5 = sreg ;; Offsets in the theme struct ulcornerpattern = 8 titlebarpattern = ulcornerpattern+8 urcornerpattern = titlebarpattern+8 rborderpattern = urcornerpattern+8 lrcornerpattern = rborderpattern+8 lowerborderpattern = lrcornerpattern+8 llcornerpattern = lowerborderpattern+8 lborderpattern = llcornerpattern+8 buttonleftpattern = lborderpattern+8 buttonrightpattern = buttonleftpattern+8 .bss tmp01: .res 1 tmpl: .res 1 tmpf: .res 1 tmpc: .res 1 tmpw: .res 1 tmpptr: .res 2 tmpy: .res 1 tmph: .res 1 ;; Window border parameters w: .res 1 wpw = 0 h: .res 1 wph = 1 clipy1: .res 1 wpclipy1 = 2 clipy2: .res 1 wpclipy2 = 3 color1: .res 1 wpcolor1 = 4 color2: .res 1 wpcolor2 = 5 titlecolor: .res 1 wptitlecolor = 6 titlelen: .res 1 wptitlelen = 7 title: .res 2 wptitle = 8 ;--------------------------------------------------------------------- .data ;--------------------------------------------------------------------- .code setupptrs: ;; Find hires address. lda _ctk_80col_cursy asl tax lda _ctk_80col_yhiresaddr,x sta ptr2 lda _ctk_80col_yhiresaddr+1,x sta ptr2+1 ;; Add X coordinate to the hires address. lda #0 sta ptr1+1 lda _ctk_80col_cursx asl rol ptr1+1 ; asl ; rol ptr1+1 asl rol ptr1+1 clc adc ptr2 and #$f8 sta ptr2 lda ptr2+1 adc ptr1+1 sta ptr2+1 ;; Find screen address. lda _ctk_80col_cursy asl tax lda _ctk_80col_cursx lsr clc adc _ctk_80col_yscreenaddr,x sta ptr1 lda _ctk_80col_yscreenaddr+1,x adc #0 sta ptr1+1 ;; Turn off interrupts, prepare $01 to store color data in RAM ;; under I/O area. sei lda $01 sta tmp01 and #$f8 sta $01 rts ;--------------------------------------------------------------------- restore01: lda tmp01 sta $01 cli rts ;--------------------------------------------------------------------- _ctk_80col_cclear: sta tmpl cmp #0 bne @norts rts @norts: jsr setupptrs ldy tmpl lda _ctk_80col_color : sta (ptr1),y dey bpl :- ;; Store either $00 or $ff in hires memory, depending on the ;; reversed flag ldx tmpl lda _ctk_80col_reversed beq @noff lda #$ff @noff: sta tmpf @loop1: ldy #7 lda tmpf @loop2: sta (ptr2),y dey bpl @loop2 lda ptr2 clc adc #8 sta ptr2 bcc @noinc inc ptr2+1 @noinc: inc _ctk_80col_cursx dex bpl @loop1 jmp restore01 ;--------------------------------------------------------------------- _ctk_80col_chline: sta tmpl cmp #0 bne @norts rts @norts: jsr setupptrs ;; Store horizontal line pattern in hires memory ldx tmpl @loop1: ldy #0 lda #$00 sta (ptr2),y iny lda #$00 sta (ptr2),y iny lda #$00 sta (ptr2),y iny lda #$ff sta (ptr2),y iny lda #$ff sta (ptr2),y iny lda #$00 sta (ptr2),y iny lda #$00 sta (ptr2),y iny lda #$00 sta (ptr2),y lda ptr2 clc adc #8 sta ptr2 bcc @noinc inc ptr2+1 @noinc: inc _ctk_80col_cursx dex bne @loop1 jmp restore01 ;--------------------------------------------------------------------- _ctk_80col_cputc: sta tmpc jsr setupptrs ;; Turn on font ROM lda tmp01 and #$f8 ora #$01 sta $01 lda #0 sta ptr1+1 ;; Convert from PETSCII to screen encoding lda tmpc eor #$e0 clc adc #$20 bpl @cont adc #$40 bpl @cont eor #$a0 @cont: ldx _ctk_80col_reversed beq :+ eor #$80 : ;; Convert to address in character ROM asl rol ptr1+1 asl rol ptr1+1 asl rol ptr1+1 sta ptr1 lda #$d8 adc ptr1+1 sta ptr1+1 lda _ctk_80col_cursx and #1 beq @left ;; Print on hires screen, bottom-up. If we should underline, ;; we do this by eor:ing the bottom line with #$ff ldy #7 lda (ptr1),y ldx _ctk_80col_underline beq @rightnounderline eor #$ff @rightnounderline: tax lda (ptr2),y and #$f0 ora _ctk_80col_righttab,x sta (ptr2),y dey @rightloop: lda (ptr1),y tax lda (ptr2),y and #$f0 ora _ctk_80col_righttab,x sta (ptr2),y dey bpl @rightloop inc _ctk_80col_cursx jmp restore01 @left: ;; Print on hires screen, bottom-up. If we should underline, ;; we do this by eor:ing the bottom line with #$ff ldy #7 lda (ptr1),y ldx _ctk_80col_underline beq @nounderline eor #$ff @nounderline: tax lda (ptr2),y and #$0f ora _ctk_80col_lefttab,x sta (ptr2),y dey @loop: lda (ptr1),y tax lda (ptr2),y and #$0f ora _ctk_80col_lefttab,x sta (ptr2),y dey bpl @loop inc _ctk_80col_cursx jmp restore01 ;--------------------------------------------------------------------- _ctk_80col_cputsn: sta tmpl cmp #0 bne :+ jmp incsp2 : jsr setupptrs ;; Turn on font ROM lda tmp01 and #$f8 ora #$01 sta $01 ;; Output each character from the string lda #0 sta tmpc ldy #0 lda (sp),y sta ptr3 iny lda (sp),y sta ptr3+1 @loop1: lda #0 sta ptr1+1 ldy tmpc lda (ptr3),y bne :+ jmp @end : ;; Convert from PETSCII to screen encoding eor #$e0 clc adc #$20 bpl @cont adc #$40 bpl @cont eor #$a0 @cont: ldx _ctk_80col_reversed beq :+ eor #$80 : ;; Convert to address in character ROM asl rol ptr1+1 asl rol ptr1+1 asl rol ptr1+1 sta ptr1 lda #$d8 adc ptr1+1 sta ptr1+1 lda _ctk_80col_cursx and #1 beq @left ;; Print on hires screen, bottom-up. If we should underline, ;; we do this by eor:ing the bottom line with #$ff ldy #7 lda (ptr1),y ldx _ctk_80col_underline beq @rightnounderline eor #$ff @rightnounderline: tax lda (ptr2),y and #$f0 ora _ctk_80col_righttab,x sta (ptr2),y dey @rightloop: lda (ptr1),y tax lda (ptr2),y and #$f0 ora _ctk_80col_righttab,x sta (ptr2),y dey bpl @rightloop lda ptr2 clc adc #8 sta ptr2 bcc :+ inc ptr2+1 : inc _ctk_80col_cursx jmp @loopend @left: ;; Print on hires screen, bottom-up. If we should underline, ;; we do this by eor:ing the bottom line with #$ff ldy #7 lda (ptr1),y ldx _ctk_80col_underline beq @nounderline eor #$ff @nounderline: tax lda (ptr2),y and #$0f ora _ctk_80col_lefttab,x sta (ptr2),y dey @loop: lda (ptr1),y tax lda (ptr2),y and #$0f ora _ctk_80col_lefttab,x sta (ptr2),y dey bpl @loop inc _ctk_80col_cursx @loopend: inc tmpc lda tmpc cmp tmpl beq :+ jmp @loop1 : @end: jsr restore01 jmp incsp2 ;--------------------------------------------------------------------- _ctk_80col_clear_line: sta tmpl asl tax lda _ctk_80col_yscreenaddr,x sta ptr1 lda _ctk_80col_yscreenaddr+1,x sta ptr1+1 lda _ctk_80col_yhiresaddr,x sta ptr2 lda _ctk_80col_yhiresaddr+1,x sta ptr2+1 sei lda $01 sta tmp01 and #$f8 sta $01 ldy #39 ldx tmpl lda _ctk_80col_screencolors,x : sta (ptr1),y dey bpl :- lda tmpl asl asl asl tax ldy #0 : lda _ctk_80col_screenpattern,x sta (ptr2),y iny lda _ctk_80col_screenpattern+1,x sta (ptr2),y iny lda _ctk_80col_screenpattern+2,x sta (ptr2),y iny lda _ctk_80col_screenpattern+3,x sta (ptr2),y iny lda _ctk_80col_screenpattern+4,x sta (ptr2),y iny lda _ctk_80col_screenpattern+5,x sta (ptr2),y iny lda _ctk_80col_screenpattern+6,x sta (ptr2),y iny lda _ctk_80col_screenpattern+7,x sta (ptr2),y iny bne :- inc ptr2+1 : lda _ctk_80col_screenpattern,x sta (ptr2),y iny lda _ctk_80col_screenpattern+1,x sta (ptr2),y iny lda _ctk_80col_screenpattern+2,x sta (ptr2),y iny lda _ctk_80col_screenpattern+3,x sta (ptr2),y iny lda _ctk_80col_screenpattern+4,x sta (ptr2),y iny lda _ctk_80col_screenpattern+5,x sta (ptr2),y iny lda _ctk_80col_screenpattern+6,x sta (ptr2),y iny lda _ctk_80col_screenpattern+7,x sta (ptr2),y iny cpy #$40 bne :- lda tmpl cmp #24 bne :+ sta _ctk_80col_cursy lda #2 sta _ctk_80col_cursx jsr restore01 lda #<_ctk_80col_versionstring ldx #>_ctk_80col_versionstring jsr pushax lda _ctk_80col_versionstring_len jmp _ctk_80col_cputsn : jmp restore01 ;--------------------------------------------------------------------- _ctk_80col_draw_bitmapline: sta tmpl cmp #0 bne :+ rts : jsr setupptrs ldy #0 lda _ctk_80col_color : sta (ptr1),y iny cpy tmpl bne :- lda _ctk_80col_bitmapptr sta ptr1 lda _ctk_80col_bitmapptr+1 sta ptr1+1 ldy #0 ldx #0 : lda (ptr1),y sta (ptr2),y iny inx cpx #8 bne :- ldx #0 dec tmpl bne :- jmp restore01 ;--------------------------------------------------------------------- _ctk_80col_draw_windowborders: jsr setupptrs lda _ctk_80col_windowparams + wpclipy1 beq :+ jmp @nofirstline : ;; Draw first line of the border, including the window title ;; Start with filling color memory lda _ctk_80col_windowparams + wpw sta tmpw ldy #0 lda _ctk_80col_windowparams + wptitlecolor : sta (ptr1),y iny cpy tmpw bcc :- dec tmpw ;; Set color for upper right corner sta (ptr1),y iny sta (ptr1),y ;; Turn on font ROM for drawing the title lda tmp01 and #$f8 ora #$01 sta $01 ;; Use a temporary pointer (ptr3) rather than ptr2 so we can ;; reuse it later. lda ptr2 sta ptr3 lda ptr2+1 sta ptr3+1 ;; Draw upper left corner ldy #7 : lda _ctk_80col_theme+ulcornerpattern,y sta (ptr3),y dey bpl :- lda ptr3 clc adc #$8 sta ptr3 bcc :+ inc ptr3+1 : ;; Draw window title bar pattern @titlebarloop: ldy #7 : lda _ctk_80col_theme+titlebarpattern,y sta (ptr3),y dey bpl :- lda ptr3 clc adc #$8 sta ptr3 bcc :+ inc ptr3+1 : ;; Loop until we are three characters away from right border ;; to avoid flickering since we would be overwriting the close ;; button. dec tmpw bpl @titlebarloop ;; Draw upper right corner piece ldy #7 : lda _ctk_80col_theme+urcornerpattern,y sta (ptr3),y dey bpl :- @nofirstline: ldx _ctk_80col_windowparams + wph inx stx tmph ;; Draw left and right borders ;; Fill color memory (pointer in ptr1, setup by setupptrs) ;; First check how much we actually should draw by inspecting ;; the clipy1 and clipy2 fields in the _ctk_80col_windowparams ;; structure lda #1 sta tmpy ldx _ctk_80col_windowparams + wpclipy1 @clipy1loop: cpx #0 beq @clipy1loopend lda ptr1 clc adc #$28 sta ptr1 bcc :+ inc ptr1+1 : lda ptr3 clc adc #$40 sta ptr3 lda ptr3+1 adc #1 sta ptr3+1 inc tmpy dex jmp @clipy1loop @clipy1loopend: lda ptr1 clc adc #$28 sta ptr1 bcc :+ inc ptr1+1 : ldx tmpy ldy _ctk_80col_windowparams + wpw iny sty tmpw @bordercloop: cpx _ctk_80col_windowparams + wpclipy2 beq @bordercloopend ldy tmpw lda _ctk_80col_windowparams + wpcolor2 sta (ptr1),y ldy #0 lda _ctk_80col_windowparams + wpcolor1 sta (ptr1),y lda ptr1 clc adc #$28 sta ptr1 bcc :+ inc ptr1+1 : inx cpx tmph bcc @bordercloop beq @bordercloop @bordercloopend: ;; Fill color memory for lower border, if clipy2 allows cpx _ctk_80col_windowparams + wpclipy2 beq @noclowerborder lda ptr1 sec sbc #$28 sta ptr1 bcs :+ dec ptr1+1 : ldy _ctk_80col_windowparams + wpw lda _ctk_80col_windowparams + wpcolor2 @lbordercloop: sta (ptr1),y dey bne @lbordercloop @noclowerborder: ;; Draw right border ldx tmpy @rborderloop: cpx _ctk_80col_windowparams + wpclipy2 beq @rborderloopend lda ptr3 clc adc #$40 sta ptr3 lda ptr3+1 adc #1 sta ptr3+1 ldy #7 : lda _ctk_80col_theme+rborderpattern,y sta (ptr3),y dey bpl :- inx cpx tmph bne @rborderloop @rborderloopend: cpx _ctk_80col_windowparams + wpclipy2 beq @norbordercorner lda ptr3 clc adc #$40 sta ptr3 lda ptr3+1 adc #1 sta ptr3+1 ;; Draw lower right corner, if clipy2 allows it ldy #7 : lda _ctk_80col_theme+lrcornerpattern,y sta (ptr3),y dey bpl :- @norbordercorner: stx tmpy ;; Draw lower border ldx _ctk_80col_windowparams + wpw @lowerborderloop: lda ptr3 sec sbc #$8 sta ptr3 bcs :+ dec ptr3+1 : lda tmpy cmp _ctk_80col_windowparams + wpclipy2 beq @nolowerborder ldy #7 : lda _ctk_80col_theme+lowerborderpattern,y sta (ptr3),y dey bpl :- @nolowerborder: dex bne @lowerborderloop lda ptr3 sec sbc #$8 sta ptr3 bcs :+ dec ptr3+1 : ldx tmpy cpx tmph bne @nolbordercorner ;; Draw lower left corner, if clipy2 allows it ldy #7 : lda _ctk_80col_theme+llcornerpattern,y sta (ptr3),y dey bpl :- lda ptr3 sec sbc #$40 sta ptr3 lda ptr3+1 sbc #1 sta ptr3+1 @nolbordercorner: ;; Draw left border @lborderloop: cpx #1 beq @lborderloopend cpx _ctk_80col_windowparams + wpclipy1 bcc @lborderloopend ldy #7 : lda _ctk_80col_theme+lborderpattern,y sta (ptr3),y dey bpl :- lda ptr3 sec sbc #$40 sta ptr3 lda ptr3+1 sbc #1 sta ptr3+1 dex jmp @lborderloop @lborderloopend: jmp restore01 ;---------------------------------------------------------------------