1;
2;       Z88DK Graphics Functions
3;
4;       Draw a "gfx profile" metadata stream - Stefano Bodrato 16/10/2009
5;
6;		void draw_profile(int dx, int dy, int scale, unsigned char *metapic);
7;
8;	$Id: draw_profile.asm,v 1.10 2016-11-28 07:33:11 stefano Exp $
9;
10
11
12IF !__CPU_GBZ80__ && !__CPU_INTEL__
13	INCLUDE	"graphics/grafix.inc"
14
15
16		SECTION	  code_graphics
17                PUBLIC    draw_profile
18                PUBLIC    _draw_profile
19
20                EXTERN     stencil_init
21                EXTERN     stencil_render
22                EXTERN		stencil_add_point
23                EXTERN		stencil_add_lineto
24                EXTERN		stencil_add_side
25                EXTERN		plot
26                EXTERN		unplot
27                EXTERN		draw
28                EXTERN		undraw
29                EXTERN		drawto
30                EXTERN		undrawto
31
32                EXTERN		l_mult
33                EXTERN		l_div
34
35
36getbyte:
37	ld	hl,(_pic)
38	ld	a,(hl)
39	inc	hl
40	ld	(_pic),hl
41	ret
42
43getx:
44	ld	hl,(_vx)
45IF maxx > 320
46	call getparmx
47ELSE
48	call getparm
49ENDIF
50;IF maxx > 320
51;	add hl,hl	; double size for X in wide mode !
52;ENDIF
53	ret
54
55IF maxx > 320
56getparmx:		;cx=vx+percent*pic[x++]/50;  (double width)
57	push hl
58	ld	de,(_percent)
59	call	getbyte
60	ld	h,0
61	ld	l,a
62	call l_mult
63IF ((maxx/(maxy+1))>1)
64	ld	de,25	; 50/2
65ELSE
66	ld	de,50
67ENDIF
68	jr  perc_div
69ENDIF
70
71
72
73
74gety:
75	ld	hl,(_vy)
76	call getparm
77	ret
78
79getparm:		;cx=vx+percent*pic[x++]/100;
80	push hl
81	ld	de,(_percent)
82	call	getbyte
83	ld	h,0
84	ld	l,a
85	call l_mult
86	ld	de,50	; 100/2
87perc_div:
88	ex	de,hl
89	call l_div
90	pop	de
91	add	hl,de
92;	ld	a,$F0	; negative value ?
93;	and	h
94;	ret z
95;	ld	hl,0
96	ret
97
98
99; *************************
100;    MAIN FUNCTION ENTRY
101; *************************
102
103draw_profile:
104_draw_profile:
105	push	ix
106	ld	ix,2
107	add ix,sp
108	ld	l,(ix+2)
109	ld	h,(ix+3)
110	ld	(_pic),hl
111	ld	l,(ix+4)
112	;ld	h,0
113	ld	h,(ix+5)
114	srl h
115	rr l
116	ld	(_percent),hl
117	ld	l,(ix+6)
118IF (maxx > 256)
119	ld	h,(ix+7)
120ENDIF
121	ld	(_vy),hl
122	ld	l,(ix+8)
123IF (maxx > 256)
124	ld	h,(ix+9)
125ENDIF
126	ld	(_vx),hl
127
128IF (maxx > 256)
129	ld      hl,-maxy*4	; create space for stencil on stack
130ELSE
131	ld      hl,-maxy*2	; create space for stencil on stack
132ENDIF
133	add     hl,sp		; The stack usage depends on the display height.
134	ld      sp,hl
135	ld		(_stencil),hl
136
137picture_loop:
138	ld		a,(repcnt)
139	and		a
140	jr		z,norepeat
141	dec		a
142	ld		(repcnt),a
143	ld		a,(repcmd)
144	jr		noend
145norepeat:
146	call	getbyte
147	and	a		; CMD_END ?
148	jr		nz,noend
149	;******
150	; EXIT
151	;******
152IF (maxx > 256)
153	ld      hl,maxy*4	; release the stack space for _stencil
154ELSE
155	ld      hl,maxy*2	; release the stack space for _stencil
156ENDIF
157	add     hl,sp
158	ld      sp,hl
159	pop	ix
160	ret
161
162noend:
163	ld	e,a
164	and $0F		; 'dithering level'
165	ld  h,0
166	ld  l,a
167	ld	(_dith),hl
168	ld	a,e
169	and $F0		; command
170
171	ld	hl,(_stencil)
172
173;#define CMD_AREA_INIT		0x80	/* no parms */
174;#define CMD_AREA_INITB		0x81	/* activate border mode */
175;#define REPEAT_COMMAND		0x82	/* times, command */
176
177	cp  $80		; CMD_AREA_INIT (no parameters)
178	jr	nz,noinit
179	push hl		; _stencil
180	ld	a,(_dith)
181	cp	2
182	jr	z,do_repeat
183	ld	hl,0
184	ld	(_areaptr),hl
185	and a			; no parameters ?
186	jr	z,just_init	; then, don't keep ptr for border
187	dec	a
188	jr	z,init_loop		;$81 ?
189	; else (82..) REPEAT_COMMAND
190do_repeat:
191	call getbyte
192	ld	(repcnt),a
193	call getbyte
194	ld	(repcmd),a
195	jp	go_end1
196init_loop:
197	ld	hl,(_pic)	; >0, so save current pic ptr
198	ld	(_areaptr),hl
199just_init:
200	pop	hl
201	push hl		; _stencil
202	call stencil_init
203	jp	go_end1
204noinit:
205
206	cp  $F0		; CMD_AREA_CLOSE (no parameters ?)
207	jr	nz,noclose
208;----
209	call is_areamode
210	jr	z,noclsamode
211	push hl
212	ld	hl,(_areaptr)
213	ld	(_pic),hl	; update picture pointer to pass the area
214	ld	hl,0		; twice and draw the border
215	ld	(_areaptr),hl
216	pop hl
217noclsamode:
218;----
219	push hl		; _stencil
220	ld	hl,(_dith)
221	ld	a,l
222	sub 12
223	jr	c,doclose
224	; if color > 11 we roughly leave a black border by shrinking
225	; the stencil boundaries, then we subtract 7 and fill with the
226	; resulting dithering level (12..15 -> 4..7)
227	ld	l,11	; black border
228	push hl
229	call stencil_render
230	pop	de
231	pop hl
232	ld	hl,(_stencil)	; 'render' can destroy the current parameter
233	push hl
234	ld	e,1		; left side border
235	call resize
236	ld	e,-1	; right side border
237	call resize
238	;pop hl
239	;push hl
240	;call vshrink	; upper side border
241	;;;ld	hl,_stencil+maxy
242	;ld	hl,_stencil
243	;ld	de,maxy
244	;add	hl,de
245	;call vshrink	; lower side border
246	ld	hl,(_dith)
247	ld	a,l
248	sub	7		; adjust dithering to mid values
249	ld	l,a
250doclose:
251	jp	dorender
252noclose:
253	push af
254
255;----
256	call is_areamode
257	jr	z,noamode	; if in 'area mode', we are doing twice;
258	pop	af			; in the first pass, plot/line CMDs
259	or $80			; are changed to the equivalent area ones
260	push af
261noamode:
262;----
263
264	pop	af
265	push af
266
267	cp	$30		; CMD_HLINETO (1 parameter)
268	jr	z,xparm
269	cp	$B0		; CMD_AREA_HLINETO (1 parameter)
270	jr	nz,noxparm
271xparm:
272	call getx
273	ld	(_cx),hl
274	jr	twoparms
275noxparm:
276
277	cp	$40		; CMD_VLINETO (1 parameter)
278	jr	z,yparm
279	cp	$C0		; CMD_AREA_VLINETO (1 parameter)
280	jr	nz,noyparm
281yparm:
282	call gety
283	ld	(_cy),hl
284	jr	twoparms
285noyparm:
286
287	cp  $50		; CMD_LINE (4 parameters ?)
288	jr	z,fourparms
289	cp  $D0		; CMD_AREA_LINE (4 parameters ?)
290fourparms:
291	push af		; keep zero flag
292	call getx
293	ld	(_cx),hl
294	call gety
295	ld	(_cy),hl
296	pop	af		; recover zero flag
297	jr	nz,twoparms
298	call getx
299	ld	(_cx1),hl
300	call gety
301	ld	(_cy1),hl
302twoparms:
303
304	pop	af
305
306	ld	hl,(_cx)
307	push hl
308	ld	hl,(_cy)
309	push hl
310
311	cp	$90	; CMD_AREA_PLOT (x,y)
312	jr	nz,noaplot
313	ld	hl,(_stencil)
314	push hl
315	call stencil_add_point
316	jr  go_end3
317noaplot:
318
319	cp	$A0	; CMD_AREA_LINETO (x,y)
320	jr	c,noaline
321	cp	$D0
322	jr	z,aline
323	jr	nc,noaline ; >= CMD_AREA_VLINETO
324	; AREA_LINETO stuff
325	ld	hl,(_stencil)
326	push hl
327	call stencil_add_lineto
328	jr	go_end3
329
330aline:
331	;cp $D0 ; CMD_AREA_LINE (x1,x2,y1,y2)
332	;jr	nz,noaline
333	ld	hl,(_cx1)
334	ld	(_cx),hl	; update also the first parameter couple...
335	push hl
336	ld	hl,(_cy1)
337	ld	(_cy),hl	; ..so VLINE and HLINE behave correctly
338	push hl
339	ld	hl,(_stencil)
340	push hl
341	call stencil_add_side
342	pop hl
343go_end4:
344	pop	hl
345go_end3:
346	pop	hl
347go_end2:
348	pop	hl
349go_end1:
350	pop	hl
351	jp	picture_loop
352noaline:
353
354	cp $10 ; CMD_PLOT (x,y,dither),
355	jr	nz,noplot
356	ld	hl,(_stencil)
357	ld	a,(_dith)
358	and	a			; when possible drawto/undrawto are faster
359	jr	nz,nopwhite
360	call unplot
361	jr	go_end2
362nopwhite:
363	sub 11
364	jr	nz,nopblack
365	call plot
366	jr	go_end2
367nopblack:
368	push hl
369	call stencil_init
370	call stencil_add_point
371plend:
372	pop de	; stencil ptr
373plend2:
374	pop hl
375	pop hl
376	push de	; stencil ptr
377	ld	hl,(_dith)
378	ld	a,l
379	sub 12			; If color > 11, then fatten a bit
380	jr	c,nothick	; the surface to be drawn
381
382	push hl
383	ld hl,(_stencil)	; adjust the right side
384IF (maxx > 256)
385	ld	de,maxy*2
386ELSE
387	ld	de,maxy
388ENDIF
389	add	hl,de
390	ld e,1				; 1 bit larger
391	call resize
392	pop hl
393	ld	a,l
394	sub 4	; adjust color (8..11)
395	ld	l,a
396nothick:
397dorender:
398	push hl
399	call stencil_render
400	pop	hl
401	pop hl
402	ld	hl,(_stencil)	; 'render' can destroy the current parameter
403	push hl
404	call stencil_init
405	jr go_end1
406
407noplot:
408
409	cp $20		; CMD_LINETO (x,y,dither),
410	jr c,go_end2
411	cp $50		; CMD_LINE
412	jr z,line
413	jr nc,go_end2
414	; LINETO stuff
415	ld hl,(_stencil)
416	ld a,(_dith)
417	and a				; when possible drawto/undrawto are faster
418	jr nz,nodtwhite
419	call undrawto
420	jr	go_end2
421nodtwhite:
422	sub	11
423	jr	nz,nodtblack
424	call drawto
425	jr	go_end2
426nodtblack:
427	push hl
428	call stencil_init
429	call stencil_add_lineto
430	jr plend
431
432line:
433	;cp $50 ; CMD_LINE (x,y,x2,y2,dither),
434	;jr	nz,go_end2
435	ld	hl,(_cx1)
436	ld	(_cx),hl	; update also the first parameter couple...
437	push hl
438	ld	hl,(_cy1)
439	ld	(_cy),hl	; ..so VLINE and HLINE behave correctly
440	push hl
441	ld	hl,(_stencil)
442	ld	a,(_dith)
443	and	a			; when possible draw/undraw are faster
444	jr	nz,nolwhite
445	call undraw
446	jp	go_end4
447nolwhite:
448	sub	11
449	jr	nz,nolblack
450	call draw
451	jp	go_end4
452nolblack:
453	push hl
454	call stencil_init
455	call stencil_add_side
456	pop de
457	pop	hl
458	pop hl
459	jp plend2
460
461;
462; Adjust right or left margin
463; of a stencil object by 'e' dots
464;
465
466resize:
467
468IF (maxx > 256)
469
470	;EXTERN  l_graphics_cmp
471	; TODO
472	ret
473
474ELSE
475
476	ld b,maxy-1
477rslp:
478	ld a,(hl)
479	and a
480	jr z,slimit
481	cp maxx-1
482	jr z,slimit
483	add e
484	ld (hl),a
485slimit:
486	inc hl
487	djnz rslp
488	ret
489
490ENDIF
491
492; NZ if we have prepared a ptr for two-pass mode
493is_areamode:
494	push hl		; _stencil
495	ld	hl,_areaptr
496	ld	a,(hl)
497	inc	hl
498	cp	(hl)
499	pop	hl
500	ret
501;
502; Cut 1st and last line from a stencil object
503;
504
505;vshrink:
506;	ld	b,maxy-1
507;ltop:
508;	ld	a,(hl)
509;	and	a
510;	jr	z,slim2
511;	cp	maxx-1
512;	jr	z,slim2
513;	dec hl
514;	ld	a,(hl)
515;	inc	hl
516;	ld	(hl),a
517;	jr	bottom
518;slim2:
519;	ld	e,a
520;	inc hl
521;	djnz ltop
522;	ret
523;bottom:
524;	ld	b,maxy-1
525;lbottom:
526;	inc	hl
527;	ld	a,(hl)
528;	and	a
529;	jr	z,slim3
530;	cp	maxx-1
531;	jr	nz,slim4
532;slim3:
533;	dec	hl
534;	ld	(hl),a
535;	ret
536;slim4:
537;	inc	hl
538;	djnz lbottom
539;	ret
540
541	SECTION	bss_graphics
542
543_areaptr:	defw	0
544
545_percent:	defw	0
546_cmd:		defb	0
547_dith:		defw	0
548_vx:		defw	0
549_vy:		defw	0
550
551_cx:		defw	0
552_cy:		defw	0
553_cx1:		defw	0
554_cy1:		defw	0
555
556_pic:		defw	0
557
558repcmd:		defb	0
559repcnt:		defb	0
560
561; moved into stack
562;;_stencil:	defs	maxy*2
563_stencil:	defw	0
564ENDIF
565