dsforth/main_emit8.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; 8x8 font printing engine
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4
   5   IF USE_EMIT8_DRIVER
   6
   7 $FORTH_CONST EMIT-8X8? 1
   8
   9 emit8_coordx defb 0
  10 emit8_coordy defb 0
  11
  12 emit8_blockchar:
  13   defs 8,0
  14
  15 emit8_udg_addr defw #D000
  16 $FORTH_CONST (UDG)  emit8_udg_addr
  17
  18 $FORTH_WORD UDG
  19 ;; k8
  20 ;; ( -- addr )
  21   (UDG) @ ;S
  22 $FORTH_END_WORD UDG
  23
  24
  25   IF USE_PRINT_ATTRS
  26 emit8_do_scroll_subr equ emit6_do_scroll_subr
  27   ELSE
  28 emit8_do_scroll_subr:
  29   call  #0DFE    ;; CL-SC-ALL
  30   ; set attribute for the lower part
  31   ld    hl,scrattr8x8(0,23)
  32   ld    de,scrattr8x8(1,23)
  33   ld    a,(emit6_attrp)
  34   ld    (hl),a
  35   ld    bc,31
  36   ldir
  37   ret
  38   ENDIF
  39
  40
  41 ;; expand to block char pattern
  42 fword_xemit8_expand_a:
  43   and   #03
  44   bit   1,a
  45   jr    z,.skip00
  46   res   1,a
  47   or    #F0
  48 .skip00:
  49   bit   0,a
  50   ret   z
  51   or    #0F
  52   ret
  53
  54
  55 $FORTH_CODE_WORD XEMIT8
  56 ;; k8
  57 ;; ( c -- )
  58 fword_xemit8:
  59   ld    hl,(emit8_coordx)
  60   ; check high parts
  61   ld    a,l
  62   cp    32
  63   jr    c,fword_xemit8_xok
  64   ld    l,255
  65   inc   h
  66 fword_xemit8_xok:
  67   inc   l
  68   ld    a,h
  69   cp    24
  70   jr    c,fword_xemit8_yok
  71   ld    h,23
  72   ld    (emit8_coordx),hl
  73   push  bc
  74   call  emit6_do_scroll_subr
  75   pop   bc
  76   ld    hl,(emit8_coordx)
  77 fword_xemit8_yok:
  78   ld    (emit8_coordx),hl
  79   dec   l
  80   ; h: y
  81   ; l: x
  82   ex    de,hl
  83   ld    a,d
  84   and   #18
  85   or    #40
  86   ld    h,a
  87   ld    a,d
  88   rrca
  89   rrca
  90   rrca
  91   and   #E0
  92   or    e
  93   ld    l,a
  94   ; HL: screen address
  95   pop   de
  96   ex    de,hl
  97   bit   7,l
  98   jr    z,fword_xemit8_normal
  99   ; UDGs
 100   ld    a,l
 101   and   #7F
 102   sub   16
 103   jr    c,fword_xemit8_block
 104   ld    l,a
 105   ld    h,0
 106   add   hl,hl
 107   add   hl,hl
 108   add   hl,hl
 109   push  de
 110   ld    de,(emit8_udg_addr)
 111   add   hl,de
 112   pop   de
 113   jr    fword_xemit8_dodraw
 114 fword_xemit8_block:
 115   add   a,16
 116   ; draw block char
 117   push  de
 118   ld    h,a
 119   call  fword_xemit8_expand_a
 120   ld    l,a
 121   dup 4
 122   ld    (de),a
 123   inc   d
 124   edup
 125   ld    a,h
 126   rrca
 127   rrca
 128   call  fword_xemit8_expand_a
 129   dup 3
 130   ld    (de),a
 131   inc   d
 132   edup
 133   ld    (de),a
 134   jr    fword_xemit8_putattr
 135 fword_xemit8_normal:
 136   add   hl,hl
 137   ld    h,15
 138   add   hl,hl
 139   add   hl,hl
 140 fword_xemit8_dodraw:
 141   ; draw it
 142   ; HL: char address
 143   ; DE: screen$ address
 144   ld    a,8
 145   push  de
 146 fword_xemit8_loop:
 147   ex    af,af'
 148   ld    a,(hl)
 149   inc   hl
 150   ld    (de),a
 151   inc   d
 152   ex    af,af'
 153   dec   a
 154   jr    nz,fword_xemit8_loop
 155 fword_xemit8_putattr:
 156   ; put attribute
 157   pop   hl
 158   ; conver to attribute
 159   ld   a,h
 160   rrca
 161   rrca
 162   rrca
 163   and  #03
 164   or   #58
 165   ld   h,a
 166   ld   a,(emit6_attrp)
 167   ld   (hl),a
 168   jp   i_next
 169 $FORTH_END_CODE_WORD XEMIT8
 170
 171 $FORTH_CODE_WORD EMIT8
 172 ;; k8
 173 ;; ( c -- )
 174   pop   hl
 175   ld    a,l
 176   cp    13
 177   jr    z,fword_emit_cr
 178   cp    10
 179   jr    z,fword_emit_lf
 180   push  hl
 181   jp    fword_xemit8
 182 fword_emit_cr:
 183   xor   a
 184   ld    (emit8_coordx),a
 185   jp    i_next
 186 fword_emit_lf:
 187   ld    a,(emit8_coordy)
 188   inc   a
 189   ld    (emit8_coordy),a
 190   cp    25
 191   jp    c,i_next
 192   ld    a,23
 193   ld    (emit8_coordy),a
 194   push  bc
 195   call  emit6_do_scroll_subr
 196   pop   bc
 197   jp    i_next
 198 $FORTH_END_CODE_WORD EMIT8
 199
 200 $FORTH_CODE_WORD CR8
 201 ;; k8
 202 ;; ( -- )
 203   xor   a
 204   ld    (emit8_coordx),a
 205   jr    fword_emit_lf
 206 $FORTH_END_CODE_WORD CR8
 207
 208 $FORTH_CODE_WORD SPACE8
 209 ;; k8
 210 ;; ( -- )
 211   ld    l,32
 212   push  hl
 213   jp    fword_xemit8
 214 $FORTH_END_CODE_WORD SPACE8
 215
 216 $FORTH_WORD SPACES8
 217 ;; k8
 218 ;; ( n -- )
 219   DUP 1- 0< 0BRANCH fword_spaces8_ok
 220     DROP ;S
 221 fword_spaces8_ok:
 222   0 (DO)
 223 fword_spaces8_loop:
 224     SPACE8
 225   (LOOP) fword_spaces8_loop
 226   ;S
 227 $FORTH_END_WORD SPACES8
 228
 229 $FORTH_WORD TYPE8
 230 ;; AberSoft
 231 ;; ( addr len -- )
 232   dup 0 > 0BRANCH fword_type8_1
 233   OVER + SWAP (DO)
 234 fword_type8_0:
 235   I C@ EMIT8
 236   (LOOP)  fword_type8_0
 237   BRANCH fword_type8_2
 238 fword_type8_1:
 239   2DROP
 240 fword_type8_2:
 241   ;S
 242 $FORTH_END_WORD TYPE8
 243
 244 $FORTH_WORD XTYPE8
 245 ;; AberSoft, k8
 246 ;; ( addr len -- )
 247   dup 0 > 0BRANCH fword_xtype8_1
 248   OVER + SWAP (DO)
 249 fword_xtype8_0:
 250   I C@ XEMIT8
 251   (LOOP)  fword_xtype8_0
 252   BRANCH fword_xtype8_2
 253 fword_xtype8_1:
 254   2DROP
 255 fword_xtype8_2:
 256   ;S
 257 $FORTH_END_WORD XTYPE8
 258
 259 $FORTH_CODE_WORD AT8
 260 ;; k8
 261 ;; ( y x -- )
 262   pop   hl
 263   pop   de
 264   ld    h,e
 265   ld    (emit8_coordx),hl
 266   jp    i_next
 267 $FORTH_END_CODE_WORD AT8
 268
 269 $FORTH_WORD KEY8
 270 ;; k8
 271 ;; ( -- c )
 272   (KEY-SHOW-CURSOR) C@
 273   (KEY-SHOW-CURSOR) 0C!
 274   KEY
 275   SWAP (KEY-SHOW-CURSOR) C!
 276   ;S
 277 $FORTH_END_WORD KEY8
 278
 279 $FORTH_WORD (.8")  ;;"
 280 ;; k8
 281 ;; ( -- )
 282   R> COUNT 2DUP TYPE8 + >R ;S
 283 $FORTH_END_WORD (.8")  ;;"
 284
 285 $FORTH_WORD .8" IMM  ;;"
 286 ;; k8
 287 ;; ( -- )
 288   LIT 34 STATE @ 0BRANCH fword_qs8_0
 289     COMPILE (.8")  ;;"
 290     WORD C@ 1+ ALLOT
 291     ;S
 292 fword_qs8_0:
 293   WORD COUNT TYPE8
 294   ;S
 295 $FORTH_END_WORD .8"  ;;"
 296
 297 $FORTH_WORD D.8R
 298 ;; AberSoft
 299 ;; ( d n -- )
 300   >R SWAP OVER DABS <# #S SIGN #> R> OVER - SPACES8 TYPE8 ;S
 301 $FORTH_END_WORD D.8R
 302
 303 $FORTH_WORD .8R
 304 ;; AberSoft
 305 ;; ( n1 n2 -- )
 306   >R S->D R> D.8R ;S
 307 $FORTH_END_WORD .8R
 308
 309 $FORTH_WORD D.8
 310 ;; AberSoft
 311 ;; ( d -- )
 312   0 D.8R SPACE8 ;S
 313 $FORTH_END_WORD D.8
 314
 315 $FORTH_WORD .8
 316 ;; AberSoft
 317 ;; ( n -- )
 318   S->D D.8 ;S
 319 $FORTH_END_WORD .8
 320
 321 $FORTH_WORD U.8
 322 ;; AberSoft
 323 ;; ( u -- )
 324   0 D.8 ;S
 325 $FORTH_END_WORD U.8
 326
 327 $FORTH_WORD U.8R
 328 ;; AberSoft
 329 ;; ( u n -- )
 330   >R 0 R> D.8R ;S
 331 $FORTH_END_WORD U.8R
 332
 333   ELSE
 334
 335 $FORTH_CONST EMIT-8X8? 0
 336
 337   ENDIF