; FONTSEL Parx module
; Guillaume Tello
; guillaume.tello@orange.fr
; july 2024

; version 1.01
;		bug sur les fontes avec un nom>30 caractŠres, corrig‚
; version 1.02
;     evite un second appel … vst_load_fonts s'il a d‚j… ‚t‚ fait

GEMDOS MACRO    ; fn,pile
   move #\1,-(sp)
   trap #1
   if \2<=8
      addq.l #\2,sp
   else
      add.w #\2,sp
   endif
   ENDM

		section	text

debut:	
	dc.b "READ_FOM"	; identifiant module g‚n‚ral FORTH
	dc.b "FONT"			; objets support‚s
	dc.w $0000			; type 0 pour "chargement total"
	dc.b "FONTSEL "	; nom court
	dc.w 102				; version
	dc.b "FORTH Font selector   ½GT 2024",0 ; long name (30 octets + 1 z‚ro)
	dc.b 2+1				; marqueur mots red‚finis (2) + marqueur do_param (1)
	bra modinfo
	bra modpal
	bra modexe
	bra do_param

	dc.b "FSinit",0			; red‚finit modinfo
	dc.b "FStitle",0			; red‚finit modpal
	dc.b "FSopen",0			; red‚finit modexe
	even							; assure la parit‚
		
	; flag var FSinit
	; flag=0 le module doit faire vst_load_fonts tout seul
	; flag=n c'est le nombre de fontes charg‚es
	; var variable I/O de la taille de la fonte, si 0, pas d'‚change de taille
	; renvoie n si Ok, ou 0 si GDOS non install‚
	
modinfo:
	move.l mon_arbre(pc),a1
	lea 11*24+11(a1),a1	; state du mot "POINTS"
	bset #3,(a1)			; etat disabled
	lea points_var(pc),a0
	move.l (a6)+,d0		; adresse var
	move.l d0,(a0)			; conserv‚e
	beq.s .lb0
	bclr #3,(a1)			; etat normal
	move.l d0,a1			; si non  nul, c'est bien ma variable
	moveq.l #12,d0
	move.l d0,(a1)			; var = 12 au d‚part
.lb0:
	move #813,d0
	bsr exec_forth			; vq_gdos
	move.l (a6)+,d0
	bmi.s .bug				; si n‚gatif, gdos non install‚
	move.l (a6)+,d0		; flag
	bne.s .ok
	move.l fontes(pc),d0	; valeur d‚j… install‚e?
	bne.s .ok				; oui, donc pas d'appel en plus
	move #234,d0			; sinon, premier appel
	bsr exec_forth			; vst_load_fonts
	bsr get_intout
	moveq #1,d0
	add (a0),d0				; nombre de fontes (avec le System)
.ok:
	lea fontes(pc),a0
	move.l d0,(a0)			; nombre de fontes, qui est aussi renvoy‚
	rts
.bug:
	addq.l #4,a6			; vire le flag
	moveq #0,d0
	rts

	; " titre" FStitle	: red‚finit le titre du dialogue (35 caractŠres maxi)
	; 0 FStitle				: revient au titre par d‚faut

modpal:
	lea titre_defaut(pc),a0
	move.l (a6)+,d0
	beq.s .lb0				; si nul, d‚faut
	move.l d0,a0			; sinon c'est l'adresse d'une chaŒne
.lb0:
	move.l mon_arbre(pc),a1
	move.l 1*24+12(a1),a1	; adresse chaine titre
	moveq #34,d0			; nombre maxi de caractŠres
.lb1:
	move.b (a0)+,(a1)+	; copie chaine
	dbeq d0,.lb1
	clr.b (a1)				; assure la fin
	moveq #2,d0
	rts						; renvoie Ok

	; sauvegarde les valeurs du FORTH
	; reloge le RSC
	; lance form_center et conserve les coordonn‚es
	
do_param:
	bsr save_forth_values
	lea mon_rsc(pc),a0
	move.l vdipb(pc),a1
	move.l 4(a1),a1		; adresse INTIN
	move.l #'FORT',(a1)	; marqueur pour routines internes
	move.l a0,-(a6)
	move #842,d0			; rsrc_rcfix
	bsr exec_forth
	moveq #0,d0
	bsr get_tree
	lea mon_arbre(pc),a1
	move.l a0,(a1)			; conserve l'adresse
	move.l a0,-(a6)		; pour form_center
	move.l 12*24+12(a0),a1	; tedinfo de la taille en points
	lea points(pc),a2
	move.l a2,(a1)			; fixe ma chaine pour l'‚dition de la taille
	move.l mon_arbre(pc),a0
	lea titre_defaut(pc),a1
	move.l 1*24+12(a0),a0	; adresse du titre
.lb0:
	move.b (a0)+,(a1)+	; conserve le titre par d‚faut
	bne.s .lb0	
	move #345,d0			; form_center
	bsr exec_forth
	bsr get_intout
	addq.l #2,a0
	move.l a0,-(a6)		; intout+2
	move #754,d0			; get_xywh
	bsr exec_forth		
	lea coords(pc),a0
	move.l (a6)+,(a0)+	; h
	move.l (a6)+,(a0)+	; w
	move.l (a6)+,(a0)+	; y
	move.l (a6)+,(a0)+	; x
	move.l mon_arbre(pc),a1
		; ici pr‚pare le rectangle de clipping !
	move.l 16(a1),d1		; x,y cadre de base
	move.l #$10001,d0
	lea 15*24+16(a1),a1	; coordonn‚es cadre texte
	add.l d0,d1				; d‚cale pour ‚viter le cadre autour
	add.l (a1)+,d1			; x,y cadre texte
	bsr.s .sauve_w_l
	add.l (a1)+,d1			; +w,+h
	sub.l d0,d1				; x',y'
	sub.l d0,d1				; x',y'
	sub.l d0,d1				; x',y'
	bsr.s .sauve_w_l
	moveq #0,d0				; OK
	lea fontes(pc),a0
	move.l d0,(a0)			; et efface le nombre de fontes
	rts
.sauve_w_l:
	swap d1
	clr (a0)+
	move d1,(a0)+			; x1 ou x2
	swap d1
	clr (a0)+
	move d1,(a0)+			; y1 ou y2
	rts

get_intout:
	move.l vdipb(pc),a0
	move.l 12(a0),a0		; intout	
	rts

save_forth_values:
	lea debut(pc),a0		; r‚cupŠre les donn‚es envoy‚es par MODLOAD
	lea adresse(pc),a1
	move.l -(a0),(a1)+	; adresse
	move.w -(a0),(a1)+	; handle
	move.w -(a0),(a1)+	; i_handle
	move.l -(a0),(a1)+	; aespb
	move.l -(a0),(a1)+	; vdipb
	move.l -(a0),(a1)+	; adresse variable langage.w
	move.l -(a0),(a1)+	; extra_data
	rts
	; d0=code du mot FORTH … ‚x‚cuter
	
exec_forth:
	lea adresse(pc),a0
	move.l (a0),a0			; base des adresses
	lsl.w #2,d0
	move.l 0(a0,d0.w),a0	; adresse du mot
	jsr (a0)					; execute
	rts

; pile RTS/4:sndb
; n FSelect	: ouvre le s‚lecteur avec la fonte n s‚lectionn‚e
; n=0 ne rien s‚lectionner
; n num‚ro d'ordre de la fonte comme le paramŠtre de vqt_name
; renvoie - n num‚ro de fonte choisie ou z‚ro erreur
;         - remplit la variable de taille

modexe:	
	move.l extra_data(pc),a0
	lea 12(a0),a0		; pointe sur xy_flag
	move.b (a0),2(a0)	; sauve la valeur
	sf (a0)				; mode absolute
	clr.l -(a6)
	moveq #5,d0
	move.l d0,-(a6)
	move #259,d0
	bsr exec_forth		; vst_alignment (point en haut … gauche)
	lea cadre(pc),a0
	move.l (a0)+,-(a6)
	move.l (a0)+,-(a6)
	move.l (a0)+,-(a6)
	move.l (a0)+,-(a6)	; x1,y1;x2,y2
	moveq #1,d0
	move.l d0,-(a6)
	move #236,d0			; vs_clip
	bsr exec_forth
	bsr var_to_str			; initialise la taille
	lea visible(pc),a0
	moveq #-1,d0
	move.l d0,(a0)			; fonte visible impossible pour forcer le redessin
	lea select(pc),a0
	move.l (a6)+,d7		; fonte demand‚e
	subq.l #1,d7			; 0-n
	bpl.s .lba				; encore positif, tout va
.lbc:
	move.l d0,(a0)			; sinon, select impossible
	moveq #0,d7				; et commencer au d‚but
	bra.s .lbb
.lba:
	cmp.l fontes(pc),d7
	bpl.s .lbc				; trop haut, on revient au d‚but
	move.l d7,(a0)			; sinon, select valide
.lbb:
	move.l d7,-(sp)
	moveq #0,d0
	bsr form_dial			; r‚serve ‚cran
	move.l (sp)+,d7
.boucle_gem:
	bsr set_fonts			; pr‚pare le dialogue

	clr.l -(a6)				; objet 0
	moveq #2,d0
	move.l d0,-(a6)		; profondeur 2
	bsr add_coords			; X, Y, W, H
	lea mon_arbre(pc),a0
	move.l (a0),-(a6)
	move #336,d0			; objc_draw
	bsr exec_forth
	bsr draw_font			; ajoute le petit texte dans le cadre

	moveq #12,d0
	move.l d0,-(a6)		; num‚ro de l'objet EDIT (points)
	lea mon_arbre(pc),a0
	move.l (a0),-(a6)
	move #343,d0			; form_do
	bsr exec_forth
	bsr get_intout
	moveq #0,d0
	move (a0),d0			; bouton de sortie
	bclr #15,d0				; en cas de double clic

	cmp #13,d0				; bouton OK
	bne.s .lb0
	bsr .vire_selected
	move.l select(pc),d0
	addq.l #1,d0			; renvoie fonte s‚lectionn‚e ou 0 si select=-1
	bra .exit
.lb0:
	cmp #14,d0				; bouton Abandon
	bne.s .lb1
	bsr .vire_selected
	moveq #0,d0				; renvoie 0
	bra .exit
.lb1:
	cmp #9,d0				; bouton UP
	bne.s .lb2
	move.l visible(pc),d7
	beq.s .lb1a				; d‚j… au d‚but
	subq.l #6,d7			; sinon recule de 6
.lb1a:
	bsr .vire_selected
	bra .boucle_gem
.lb2:
	cmp #10,d0				; bouton DOWN
	bne.s .lb3
	move.l visible(pc),d7
	addq.l #6,d7			; avance de 6...
	cmp.l fontes(pc),d7
	bmi.s .lb2a				; on ne d‚passe pas, ok
	subq.l #6,d7			; sinon, retour
.lb2a:
	bsr .vire_selected
	bra .boucle_gem
.lb3:
;	ici boutons chaine de 3 … 8
	move.l visible(pc),d7
	add.l d7,d0
	subq.l #3,d0			; fonte selected
	lea select(pc),a0
	move.l d0,(a0)	
	bra .boucle_gem
.exit:
	move.l d0,-(sp)		
	bsr str_to_var			; r‚cupŠre la taille de la fonte
	moveq #3,d0
	bsr form_dial
	clr.l -(a6)
	move #236,d0
	bsr exec_forth			; annule clipping
	move.l extra_data(pc),a0
	lea 12(a0),a0			; xy_flag
	move.b 2(a0),(a0)		; r‚cupŠre l'ancien flag
	move.l (sp)+,d0		; valeur retour !
	rts	
.vire_selected:
	move.l mon_arbre(pc),a0
	moveq #24,d1
	muls d0,d1
	bclr #0,11(a0,d1.l)	; vire le "selected" du bouton de sortie
	rts
	
form_dial:
	move.l d0,-(a6)		; flag
	clr.l -(a6)				; x,y,w,h
	clr.l -(a6)
	clr.l -(a6)
	clr.l -(a6)
	bsr add_coords			; X, Y, W, H
	move #344,d0			; form_dial
	bsr exec_forth
	rts

add_coords:
	lea coords+16(pc),a0
	move.l -(a0),-(a6)	; X
	move.l -(a0),-(a6)	; Y
	move.l -(a0),-(a6)   ; W
	move.l -(a0),-(a6)   ; H	
	rts
	
	; d0 nø arbre
get_tree:
	lea mon_rsc(pc),a0
	add 18(a0),a0			; pointeur arbres
	lsl.l #2,d0				; par 4
	move.l 0(a0,d0.l),a0	; mon arbre!
	rts
	
draw_font:
	move.l select(pc),d0	; une fonte s‚lectionn‚e ?
	bmi.s .exit				; si -1, non, on ne dessine pas
	addq.l #1,d0
	move.l d0,-(a6)
	move #271,d0
	bsr exec_forth			; vqt_name, demande l'ID de la fonte s‚lectionn‚e
	addq.l #4,a6			; vire pad, inutile
	bsr get_intout
	moveq #0,d0
	move (a0),d0			; id fonte
	move.l d0,-(a6)
	move #256,d0
	bsr exec_forth			; vst_font, fixe ma fonte
	moveq #13,d0
	move.l d0,-(a6)
	move #253,d0
	bsr exec_forth			; vst_height, fixe la hauteur … 13 (parfait pour SYSTEM)
	move.l vdipb(pc),a0
	move.l 16(a0),a0		; ptsout
	moveq #0,d0
	move.w 6(a0),d0		; hauteur de cellule
	lea ligne2(pc),a1
	bsr.s .ecrire
	moveq #0,d0
	lea ligne1(pc),a1
	bsr.s .ecrire
.exit:
	rts
.ecrire:
	lea cadre(pc),a0
	move.l (a0)+,d1
	addq.l #1,d1
	move.l d1,-(a6)		; x
	add.l (a0),d0			; y+dy
	addq.l #1,d0
	move.l d0,-(a6)
	move.l a1,-(a6)		; chaine
	move #239,d0
	bsr exec_forth			; v_gtext
	rts

	; d7 fonte qu'on veut voir affich‚e (parmi d'autres)
	; d7 de 1 … n
	
set_fonts:
	divs #6,d7
	muls #6,d7				; ramŠne d7 … un multiple de 6
	cmp.l visible(pc),d7	; est-ce d‚j… la mˆme?
	beq.s .ok				; oui, rien … faire.
	lea visible(pc),a0
	move.l d7,(a0)			; sinon met … jour
	moveq #5,d6				; pour la boucle
.lb0:
	move.l mon_arbre(pc),a0
	move.l d6,d0
	addq.l #3,d0
	muls #24,d0
	add.l d0,a0				; pointe sur le bon objet
	bclr #0,11(a0)			; enlŠve le select
	move.l d7,d0
	add.l d6,d0				; nøfonte de 0 … n-1
	cmp.l fontes(pc),d0	; on d‚passe le total?
	bmi.s .lb1				; non!
	bset #3,11(a0)			; si oui, ligne invalid‚e (Disabled)
	move.l 12(a0),a0		; chaŒne correspondate
	clr.b (a0)				; vid‚e!
	bra.s .lb4
.lb1:
	bclr #3,11(a0)			; valide la chaine
	cmp.l select(pc),d0	; est-ce la chaine s‚lectionn‚e?
	bne.s .lb2
	bset #0,11(a0)			; ajoute select
.lb2:
	move.l 12(a0),-(sp)	; conserve l'adresse de la chaŒne
	movem.l d6-d7,-(sp)	; et les donn‚es essentielles
	addq.l #1,d0			; fonte de 1 … n
	move.l d0,-(a6)
	move #271,d0
	bsr exec_forth			; vqt_name
	movem.l (sp)+,d6-d7
	move.l (sp)+,a0		; chaine dialogue
	move.l (a6)+,a1		; pad
	moveq #29,d0			; limite … 30 caractŠres
.lb3:
	move.b (a1)+,(a0)+	; remplit le nom de la fonte
	dbeq d0,.lb3
	clr.b (a0)
.lb4:	
	dbf d6,.lb0				; fonte suivant...
.ok:
	rts	

	; fin de dialogue, prend la taille en points (chaine)
	; et la sauvegarde dans la variable de retour
		
str_to_var:
	lea points(pc),a0		; la chaine des chiffres
	moveq #0,d0
	moveq #0,d1
.lb0:
	move.b (a0)+,d1
	beq.s .fin
	muls #10,d0
	sub.b #'0',d1
	add.l d1,d0
	bra.s .lb0
.fin:
	move.l points_var(pc),d1
	beq.s .lb1				; adresse nulle, rien … faire...
	move.l d1,a0
	move.l d0,(a0)			; met … jour la variable
.lb1:
	rts

	; d‚but de dialogue, prend la variable de taille
	; et la transforme en chaine dans le dialogue
	
var_to_str:
	move.l points_var(pc),d0
	beq.s .lb2			; pas d'‚change en fait
	move.l d0,a0
	move.l (a0),d0		; valeur … convertir
	lea points+8(pc),a0
	clr.b -(a0)
	moveq #2,d1			; pour limiter au cas o—...
.lb0:
	divs #10,d0
	swap d0
	add.b #'0',d0
	move.b d0,-(a0)
	clr d0
	swap d0
	dbeq d1,.lb0
	lea points(pc),a1
.lb1:
	move.b (a0)+,(a1)+
	bne.s .lb1
.lb2:
	rts

mon_rsc:
	INCBIN "FONTSEL.RSC"
ligne1: dc.b "The quick brown FORTH",0
ligne2: dc.b "0123456789 ˆ‚Š…—‡@#!?",0
	even

points: dc.b 0,0,0,0,0,0,0,0

	
	bss
	
adresse: ds.l 1
handle: ds.w 1
i_handle: ds.w 1
aespb: ds.l 1
vdipb: ds.l 1
langage: ds.l 1
extra_data: ds.l 1
coords: ds.l 4			; x,y,w,h de la boite
cadre: ds.l 4			; x1,y1,x2,y2 cadre clip
mon_arbre: ds.l 1
titre_defaut: ds.b 36	; 35 caractŠres + 0
fontes: ds.l 1			; nombre de fontes install‚es
visible: ds.l 1		; la fonte qu'on veut voir	(multiple de 6, 1ere du dialogue)
select: ds.l 1 		; celle qui est s‚lectionn‚e (-1 au d‚but si aucune)
points_var: ds.l 1	; adresse variable de dialogue pour la taille

	end