| blob | c5f13b3d10f737562fd552694f175678bab753ac |
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2 ;; "low-level" grapics
3 ;; AberSoft, Ketmar
4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6 $FORTH_CODE_WORD BORDER
7 ;; AberSoft
8 ;; ( c -- )
9 pop hl
10 push bc
11 ld a,l
12 call #2297
13 pop bc
14 jp i_next
15 $FORTH_END_CODE_WORD BORDER
18 $FORTH_CODE_WORD INKEY
19 ;; AberSoft
20 ;; ( -- key | 255 )
21 push bc
22 call #028E
23 ld c,#00
24 jr nz,inkey0
25 call #031E
26 jr nc,inkey0
27 dec d
28 ld e,a
29 call #0333
30 inkey0:
31 ld l,a
32 ld h,0
33 pop bc
34 jp i_pushhl
35 $FORTH_END_CODE_WORD INKEY
38 $FORTH_CODE_WORD INP
39 ;; AberSoft
40 ;; ( port -- n )
41 pop hl
42 push bc
43 ld c,l
44 ld b,h
45 in a,(c)
46 pop bc
47 ld h,0
48 ld l,a
49 jp i_pushhl
50 $FORTH_END_CODE_WORD INP
52 $FORTH_CODE_WORD OUTP
53 ;; AberSoft
54 ;; ( n port -- )
55 pop hl
56 pop de
57 push bc
58 ld c,l
59 ld b,h
60 ld a,e
61 out (c),a
62 pop bc
63 jp i_next
64 $FORTH_END_CODE_WORD OUTP
67 $FORTH_CODE_WORD BLEEP
68 ;; AberSoft
69 ;; ( cyc dur -- )
70 pop hl
71 pop de
72 push bc
73 push ix
74 call #03B5
75 pop ix
76 pop bc
77 jp i_next
78 $FORTH_END_CODE_WORD BLEEP
81 $FORTH_CODE_WORD (SCR$2ATTR)
82 ;; k8
83 ;; WARNING! address must be valid!
84 ;; ( scr$addr -- attraddr )
85 pop hl
86 ld a,h
87 rrca
88 rrca
89 rrca
90 and #03
91 or #58
92 ld h,a
93 jp i_pushhl
94 $FORTH_END_CODE_WORD (SCR$2ATTR)
97 $FORTH_CODE_WORD (SCR$COORD8)
98 ;; k8: convert character coords to screen$ bitmap address
99 ;; WARNING! coords must be valid!
100 ;; ( x y -- addr )
101 scrdollarcoord8:
102 pop hl ; y
103 pop de ; x
104 ; check high parts
105 ld a,d
106 or h
107 jr nz,.invalidcoord
108 ld a,e
109 cp 32
110 jr nc,.invalidcoord
111 ld a,l
112 cp 24
113 jr nc,.invalidcoord
114 ld d,a
115 ; d: y
116 ; e: x
117 ;ld a,d
118 and #18
119 or #40
120 ld h,a
121 ld a,d
122 rrca
123 rrca
124 rrca
125 and #E0
126 or e
127 ld l,a
128 jp i_pushhl
129 .invalidcoord:
130 ld hl,#4000
131 jp i_pushhl
132 $FORTH_END_CODE_WORD (SCR$COORD8)
135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
136 ;; convert pixel coords to screen$ bitmap address and shift
137 ;; IN:
138 ;; D: y
139 ;; E: x
140 ;; OUT:
141 ;; A: pixel shift (0: leftmost; i.e. shift for 0x80)
142 ;; HL: scr$addr
143 ;; DE: dead
144 ;; carry flag: set on error (and the result is for 0,0)
145 scrpixcoord_de:
146 ld a,d
147 cp 192
148 jr nc,.badycoord
149 and a
150 rra
151 scf
152 rra
153 and a
154 rra
155 xor d
156 and #F8
157 xor d
158 ld h,a
159 ld a,e
160 rlca
161 rlca
162 rlca
163 xor d
164 and #C7
165 xor d
166 rlca
167 rlca
168 ld l,a
169 ld a,e
170 and #07
171 ret
172 .badycoord:
173 ld hl,#4000
174 xor a
175 scf
176 ret
178 $FORTH_CODE_WORD (SCR$COORD)
179 ;; k8: convert pixel coords to screen$ bitmap address and mask
180 ;; WARNING! coords must be valid!
181 ;; ( x y -- addr mask )
182 scrdollarcoord:
183 pop hl ; y
184 pop de ; x
185 ; check high parts
186 ld a,d
187 or h
188 jr nz,.invalidcoord
189 ld d,l
190 call scrpixcoord_de
191 ; create mask
192 ex de,hl ; DE is address
193 ld h,a
194 inc h
195 ld a,0x01
196 .shift:
197 rrca
198 dec h
199 jr nz,.shift
200 ; h is guaranteed to be 0 here
201 ld l,a
202 jp i_pushde
203 .invalidcoord:
204 ld de,#4000
205 ld hl,0
206 jp i_pushde
207 $FORTH_END_CODE_WORD (SCR$COORD)
210 $FORTH_CODE_WORD (SCR$DOWN)
211 ;; k8 -- down one pixel line
212 ;; WARNING! address must be valid!
213 ;; ( scr$addr -- scr$addr )
214 scrdollardown:
215 pop hl
216 inc h
217 ld a,h
218 and #07
219 jr nz,.done
220 ld a,l
221 add a,32
222 ld l,a
223 jr c,.done
224 ld a,h
225 sub 8
226 ld h,a
227 .done:
228 jp i_pushhl
229 $FORTH_END_CODE_WORD (SCR$DOWN)
231 $FORTH_CODE_WORD (SCR$UP)
232 ;; k8 -- up one pixel line
233 ;; WARNING! address must be valid!
234 ;; ( scr$addr -- scr$addr )
235 scrdollarup:
236 ld a,h
237 dec h
238 and #07
239 jr nz,.done
240 ld a,l
241 sub 32
242 ld l,a
243 jr c,.done
244 ld a,h
245 add a,8
246 ld h,a
247 .done:
248 jp i_pushhl
249 $FORTH_END_CODE_WORD (SCR$UP)
252 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
253 ;; convert pixel coords to screen$ bitmap address and mask
254 ;; IN:
255 ;; HL: y
256 ;; DE: x
257 ;; OUT:
258 ;; A: pixel mask
259 ;; HL: scr$addr
260 ;; DE: dead
261 ;; carry flag: set on error (and the result is for 0,0)
262 scrpixcoord_dehl_mask:
263 ; check high parts
264 ld a,d
265 or h
266 jr nz,.invalidcoord
267 ld d,l
268 call scrpixcoord_de ; HL is address
269 jr c,.invalidcoord
270 ; create mask
271 ld d,a
272 inc d
273 ld a,0x01
274 .shift:
275 rrca
276 dec d
277 jr nz,.shift
278 ; D is always zero here
279 ; reset carry (just in case)
280 or a
281 ret
282 .invalidcoord:
283 ld hl,#4000
284 xor a
285 scf
286 ret
289 $FORTH_CODE_WORD POINT
290 ;; k8
291 ;; ( x y -- flag )
292 point_body:
293 pop hl ; y
294 pop de ; x
295 call scrpixcoord_dehl_mask
296 jr c,.error
297 ld e,a
298 ld a,(hl)
299 and e
300 jr z,.done
301 ld a,1
302 .done:
303 ld l,a
304 ld h,0
305 jp i_pushhl
306 .error:
307 xor a
308 jr .done
309 ;; ;; AberSoft
310 ;; ;; ( x y -- flag )
311 ;; pop hl
312 ;; pop de
313 ;; push bc
314 ;; push ix
315 ;; ld c,e
316 ;; ld b,l
317 ;; ld a,l
318 ;; cp #B0
319 ;; jr c,point0
320 ;; ld a,#af
321 ;; ld b,a
322 ;; point0:
323 ;; call #22CE
324 ;; call #1E94
325 ;; ld h,#00
326 ;; ld l,a
327 ;; pop ix
328 ;; pop bc
329 ;; jp i_pushhl
330 $FORTH_END_CODE_WORD POINT
332 $FORTH_CODE_WORD PSET
333 ;; k8
334 ;; ( x y -- )
335 pop hl ; y
336 pop de ; x
337 call scrpixcoord_dehl_mask
338 jp c,i_next
339 or (hl)
340 ld (hl),a
341 jp i_next
342 $FORTH_END_CODE_WORD PSET
344 $FORTH_CODE_WORD PRESET
345 ;; k8
346 ;; ( x y -- )
347 pop hl ; y
348 pop de ; x
349 call scrpixcoord_dehl_mask
350 jp c,i_next
351 cpl
352 ld e,a
353 ld a,(hl)
354 and e
355 ld (hl),a
356 jp i_next
357 $FORTH_END_CODE_WORD PRESET
360 $FORTH_CODE_WORD PLOT
361 ;; k8
362 ;; ( x y -- )
363 pop hl ; y
364 pop de ; x
365 plot_body:
366 ; check plot mode
367 ld a,(plot_mode)
368 and #03
369 jp z,i_next
370 ex af,af'
371 call scrpixcoord_dehl_mask
372 jp c,i_next
373 ; check plot mode
374 ex af,af'
375 ld e,a
376 ex af,af'
377 dec e
378 jr nz,.skip_or
379 ; mode 1: or
380 or (hl)
381 ld (hl),a
382 jp i_next
383 .skip_or:
384 dec e
385 jr nz,.skip_xor
386 ; mode 2: xor
387 xor (hl)
388 ld (hl),a
389 jp i_next
390 .skip_xor:
391 ; mode 3: and
392 cpl
393 ld e,a
394 ld a,(hl)
395 and e
396 ld (hl),a
397 jp i_next
398 ;; ;; AberSoft
399 ;; ;; ( x y -- )
400 ;; pop hl
401 ;; pop de
402 ;; push bc
403 ;; push ix
404 ;; ld c,e
405 ;; ld b,l
406 ;; ld a,h
407 ;; or d
408 ;; jr nz,plot0
409 ;; ld a,l
410 ;; cp #B0
411 ;; jr nc,plot0
412 ;; call #22DF
413 ;; plot0:
414 ;; pop ix
415 ;; pop bc
416 ;; jp i_next
417 $FORTH_END_CODE_WORD PLOT
419 ; 0: don't draw
420 ; 1: or
421 ; 2: xor
422 ; 3: and
423 $FORTH_CONST PLOT-MODE plot_mode
424 plot_mode: defw 1