dsforth/main_key6.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; keyboard driver
   3 ;; based on the sources from AberSoft
   4 ;; modified by Ketmar
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6
   7 keyTranTbl:
   8   defb  198,91     ;; AND->[
   9   defb  197,93     ;; OR->]
  10   defb  172,127    ;; AT->(c)
  11   defb  226,126    ;; STOP->~
  12   defb  195,124    ;; NOT->|
  13   defb  205,92     ;; STEP->\
  14   defb  204,123    ;; TO->{
  15   defb  203,125    ;; THEN->}
  16   defb  0
  17
  18 $FORTH_CONST (KEY-SHOW-CURSOR) key_show_cursor
  19 key_show_cursor: defb 1,0
  20
  21
  22 ;; show cursor, wait for key
  23 $FORTH_CODE_WORD KEY
  24 ;; k8
  25 ;; ( -- c )
  26   push  bc
  27
  28   ld    a,2
  29   call  #1601
  30
  31   ; CUR_MODE
  32   xor   a
  33   ld    (iy+7),a  ; #5C41
  34
  35   ld    a,(f_key6dontclear)
  36   or    a
  37   jr    nz,key_0
  38   ld    (f_waskeypress),a
  39
  40 key_0:
  41   ;xor   a
  42   ;ld    (LAST_K),a
  43   ;call   sub_getkey
  44
  45 ;; change cursor shape according to FRAMES
  46 key_1:
  47   ld    a,(key_show_cursor)
  48   or    a
  49   jr    z,key_x3
  50
  51   $IF USE_EMIT8_DRIVER
  52   ;; check emit driver
  53   ld    a,(conwidth_addr)
  54   cp    32
  55   jr    nz,key_draw_emit6_cursor
  56   ;; draw emit8 cursor
  57   ld    a,(emit6_attrp)
  58   push  af
  59   or    a,0x80     ;; set flash
  60   ld    (emit6_attrp),a
  61   ;; check CAPS & change cursor shape
  62   ld    a,(#5C6A)  ;; flags
  63   and   #08
  64   ld    a,'C'
  65   jr    nz,key_draw_emit6_cursor_caps
  66   ld    a,'L'
  67 key_draw_emit6_cursor_caps:
  68   call  xemit8_internal
  69   call  emit8_dobs
  70   ;; restore attributes
  71   pop   af
  72   ld    (emit6_attrp),a
  73   jr    key_x3
  74   $ENDIF
  75
  76 key_draw_emit6_cursor:
  77   ;; draw emit6 cursor
  78   ;ld    a,(#5C78)  ;; frames
  79   $IF USE_EMIT6_DRIVER
  80     $IF USE_EMIT6_DRIVER_FONT_TYPE == 0
  81       ;; full font, have full char range
  82       ld    a,(intr_frames)
  83       and   #2F        ;; each 24th frame (~0.5 sec)
  84       ld    l,177
  85       and   #20
  86       jr    z,key_x1
  87       inc   l
  88 key_x1:
  89       ;; check CAPS & change cursor shape
  90       ld    a,(#5C6A)  ;; flags
  91       and   #08
  92       jr    nz,key_x2
  93       dec   l
  94 key_x2:
  95       call  emit6_internal
  96     $ELSE
  97       ;; partial font
  98       ; save inverse
  99       ld    a,(draw6InvMask)
 100       push  af
 101       ; invert inverse
 102       or    a
 103       ld    l,a
 104       jr    nz,.key6cursor_invok
 105       ld    l,#FC
 106 .key6cursor_invok:
 107       ld    a,(intr_frames)
 108       and   #20        ;; each 24th frame (~0.5 sec)
 109       jr    z,.key6cursor_maskok
 110       ld    a,#FC
 111 .key6cursor_maskok:
 112       xor   l
 113       ld    (draw6InvMask),a
 114       ; use L or C
 115       ld    a,(#5C6A)  ;; flags
 116       and   #08
 117       ld    l,'C'
 118       jr    nz,.key6cursor_capsok
 119       ld    l,'L'
 120 .key6cursor_capsok:
 121       call  emit6_internal
 122       pop   af
 123       ld    (draw6InvMask),a
 124     $ENDIF
 125   ;;BS
 126   ld    hl,emit6x
 127   dec   (hl)
 128   $ENDIF
 129
 130 ;; wait for keypress
 131 key_x3:
 132   ;;;call #02BF      ;; keyboard
 133   ;ld    a,(#5C08)  ;; last_k
 134   ;or    a
 135   call  sub_getkey
 136   jr    z,key_1
 137
 138 ;; something's pressed
 139   cp    #06       ;; CS+2?
 140   jr    nz,key_3
 141 ;;toggle CAPS
 142   ld    hl,#5C6A  ;; flags
 143   ld    a,#08     ;; CAPS flag
 144   xor   (hl)
 145   ld    (hl),a
 146   jr    key_0
 147
 148 key_3:
 149 ;; translate codes
 150   ld    e,a
 151   ld    hl,keyTranTbl
 152 key_t0:
 153   ld    a,(hl)    ;; src
 154   inc   hl
 155   or    a         ;; end?
 156   jr    z,key_tq
 157   cp    e
 158   ld    a,(hl)    ;; dest
 159   inc   hl
 160   jr    nz,key_t0
 161   ld    e,a
 162
 163 ;; check codes
 164 key_tq:
 165   ld    a,e
 166   cp    128
 167   jr    nc,key_0
 168
 169   ld    l,a
 170   ld    h,0
 171   push  hl        ;; save keycode
 172
 173   ;; erase cursor
 174   ld    a,(key_show_cursor)
 175   or    a
 176   jr    z,key_skip_erase_cursor
 177
 178   $IF USE_EMIT8_DRIVER
 179   ;; check emit driver
 180   ld    a,(conwidth_addr)
 181   cp    32
 182   jr    nz,key_erase_emit6_cursor
 183   ;; erase emit8 cursor
 184   ld    a,32
 185   call  xemit8_internal
 186   call  emit8_dobs
 187   jr    key_skip_erase_cursor
 188   $ENDIF
 189
 190 key_erase_emit6_cursor:
 191   ;; erase emit6 cursor
 192   $IF USE_EMIT6_DRIVER
 193   ld    l,32
 194   call  emit6_internal
 195   ;;BS
 196   ld    hl,emit6x
 197   dec   (hl)
 198   $ENDIF
 199
 200 key_skip_erase_cursor:
 201   pop   hl
 202   pop   bc
 203   jp    i_pushhl
 204 $FORTH_END_CODE_WORD KEY
 205
 206
 207 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 208 ;; universal routine to get last pressed key
 209 ;; IN:
 210 ;;   nothing
 211 ;; OUT:
 212 ;;   A: key code or 0
 213 ;;   F: dead
 214 ;;   z flag is set if no key was pressed
 215 ;; returns 2 for SS+ENTER
 216 sub_getkey:
 217   ld    a,(f_waskeypress)
 218   or    a
 219   ret   z
 220   push  af
 221   xor   a
 222   ld    (f_waskeypress),a
 223   pop   af
 224 .morechecks:
 225   ; ENTER produces #13
 226   ; SS+ENTER produces #10
 227   cp    13
 228   ret   nz
 229   ; check for SS pressed
 230   ld    a,#7F
 231   in    a,(#FE)
 232 sub_getkey_port:
 233   and   #02
 234   ld    a,13
 235   ret   nz
 236   ld    a,1
 237   inc   a  ; reset Z
 238   ret
 239
 240
 241 IF 0
 242 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 243 ;; clear keyboard buffer and last pressed key
 244 ;; IN:
 245 ;;   nothing
 246 ;; OUT:
 247 ;;   AF: dead
 248 sub_clear_keybuf:
 249   xor   a
 250   ld    (f_waskeypress),a
 251   ret
 252 ENDIF
 253
 254
 255 ;; wait a key without a cursor
 256 $FORTH_WORD KEYNC
 257 ;; k8
 258 ;; ( -- c )
 259   (KEY-SHOW-CURSOR) C@
 260   (KEY-SHOW-CURSOR) 0C!
 261   KEY
 262   SWAP (KEY-SHOW-CURSOR) C!
 263   ;S
 264 $FORTH_END_WORD KEYNC