dsforth/ext0.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; standard extension words
   3 ;; original sources from AberSoft
   4 ;; slightly modified by Ketmar
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6
   7 $FORTH_CODE_WORD BORDER
   8 ;; AberSoft
   9 ;; ( c -- )
  10   pop   hl
  11   push  bc
  12   ld    a,l
  13   call  #2297
  14   pop   bc
  15   jp    i_next
  16 $FORTH_END_CODE_WORD BORDER
  17
  18
  19 $FORTH_CODE_WORD INKEY
  20 ;; AberSoft
  21 ;; ( -- key | 255 )
  22   push  bc
  23   call  #028E
  24   ld    c,#00
  25   jr    nz,inkey0
  26   call  #031E
  27   jr    nc,inkey0
  28   dec   d
  29   ld    e,a
  30   call  #0333
  31 inkey0:
  32   ld    l,a
  33   ld    h,0
  34   pop   bc
  35   jp    i_pushhl
  36 $FORTH_END_CODE_WORD INKEY
  37
  38
  39 $FORTH_CODE_WORD INP
  40 ;; AberSoft
  41 ;; ( port -- n )
  42   pop   hl
  43   push  bc
  44   ld    c,l
  45   ld    b,h
  46   in    a,(c)
  47   pop   bc
  48   ld    h,0
  49   ld    l,a
  50   jp    i_pushhl
  51 $FORTH_END_CODE_WORD INP
  52
  53 $FORTH_CODE_WORD OUTP
  54 ;; AberSoft
  55 ;; ( n port -- )
  56   pop   hl
  57   pop   de
  58   push  bc
  59   ld    c,l
  60   ld    b,h
  61   ld    a,e
  62   out   (c),a
  63   pop   bc
  64   jp    i_next
  65 $FORTH_END_CODE_WORD OUTP
  66
  67
  68 $FORTH_CODE_WORD BLEEP
  69 ;; AberSoft
  70 ;; ( cyc dur -- )
  71   pop   hl
  72   pop   de
  73   push  bc
  74   push  ix
  75   call  #03B5
  76   pop   ix
  77   pop   bc
  78   jp    i_next
  79 $FORTH_END_CODE_WORD BLEEP
  80
  81
  82 $FORTH_CODE_WORD POINT
  83 ;; AberSoft
  84 ;; ( x y -- )
  85   pop   hl
  86   pop   de
  87   push  bc
  88   push  ix
  89   ld    c,e
  90   ld    b,l
  91   ld    a,l
  92   cp    #B0
  93   jr    c,point0
  94   ld    a,#af
  95   ld    b,a
  96 point0:
  97   call  #22CE
  98   call  #1E94
  99   ld    h,#00
 100   ld    l,a
 101   pop   ix
 102   pop   bc
 103   jp    i_pushhl
 104 $FORTH_END_CODE_WORD POINT
 105
 106
 107 $FORTH_CODE_WORD (PLOT)
 108 ;; AberSoft
 109 ;; ( x y -- )
 110   pop   hl
 111   pop   de
 112   push  bc
 113   push  ix
 114 ;;
 115 ;;  PUSH HL
 116 ;;  LD   HL,PLOT-LAST-XY
 117 ;;  LD   (HL),E
 118 ;;  INC  HL
 119 ;;  LD   (HL),D
 120 ;;  INC  HL
 121 ;;  POP  BC
 122 ;;  LD   (HL),C
 123 ;;  INC  HL
 124 ;;  LD   (HL),B
 125 ;;  LD   H,B
 126 ;;  LD   L,C
 127 ;;
 128   ld    c,e
 129   ld    b,l
 130   ld    a,h
 131   or    d
 132   jr    nz,plot0
 133   ld    a,l
 134   cp    #B0
 135   jr    nc,plot0
 136   call  #22DF
 137 plot0:
 138   pop   ix
 139   pop   bc
 140   jp    i_next
 141 $FORTH_END_CODE_WORD (PLOT)
 142
 143 $FORTH_DVAR PLOT-LAST-XY 0
 144 $FORTH_WORD PLOT
 145 ;; k8
 146 ;; ( x y -- )
 147   2DUP PLOT-LAST-XY 2!
 148   (PLOT)
 149   ;S
 150 $FORTH_END_WORD PLOT
 151
 152
 153 $FORTH_DVAR (DRAW-X1) 0
 154 $FORTH_DVAR (DRAW-Y1) 0
 155 $FORTH_DVAR (DRAW-INCX) 0
 156 $FORTH_DVAR (DRAW-INCY) 0
 157
 158 $FORTH_WORD DRAW
 159 ;; AberSoft, k8
 160 ;; ( dx dy -- )
 161   ;;LIT 23678 C@ DUP 0 SWAP Y1 2! - DUP ABS ROT
 162   ;;LIT 23677 C@ DUP 0 SWAP X1 2! - DUP ABS ROT
 163   PLOT-LAST-XY    @ DUP 0 SWAP (DRAW-Y1) 2! SWAP - DUP ABS ROT
 164   PLOT-LAST-XY 2+ @ DUP 0 SWAP (DRAW-X1) 2! SWAP - DUP ABS ROT
 165   MAX >R
 166   DUP 0< 0BRANCH ldraw0
 167   ABS 0 SWAP R@ M/MOD DNEGATE BRANCH ldraw1
 168 ldraw0:
 169   0 SWAP R@ M/MOD
 170 ldraw1:
 171   (DRAW-INCX) 2! DROP
 172   DUP 0< 0BRANCH ldraw2
 173   ABS 0 SWAP R@ M/MOD DNEGATE BRANCH ldraw3
 174 ldraw2:
 175   0 SWAP R@ M/MOD
 176 ldraw3:
 177   (DRAW-INCY) 2! DROP
 178   R> 1+ 0
 179   (DO)
 180 drawNextPlot:
 181     (DRAW-X1) @ (DRAW-Y1) @ PLOT
 182     (DRAW-X1) 2@ (DRAW-INCX) 2@ D+ (DRAW-X1) 2!
 183     (DRAW-Y1) 2@ (DRAW-INCY) 2@ D+ (DRAW-Y1) 2!
 184   (LOOP) drawNextPlot
 185   ;S
 186 $FORTH_END_WORD DRAW
 187
 188 ;;;FORTH DRAWLINE
 189 ;;;;; k8
 190 ;;;;; ( sx sy dx dy -- )
 191 ;;;  PLOT DRAW
 192 ;;;  ;S
 193 ;;;$FORTH_END_WORD DRAWLINE