; ModŠle, de module FORTH
; Guillaume Tello
; guillaume.tello@orange.fr
; july 2024

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 "????"			; objets support‚s
	dc.w $0000			; type 0 = compatible PARX, sinon, n=nbr de redef diff‚rentes de modexe
	dc.b "????????"	; nom court
	dc.w 100				; version 1.00
	dc.b "1?????????2?????????3?????????",0,1 ; long name (30 caractŠres + z‚ro)
	dc.b 2+1				; 2 si mots red‚finis, 1 si do_param pr‚sent
	bra modinfo
	bra modpal
	bra modexe
	bra do_param		; si bit #0
	
	; ici, type=0, red‚finition des mots modinfo, modpal, modexe si bit #1
	
	dc.b "newmodinfo",0	; si l'un des mots n'est pas red‚fini,
	dc.b "newmodpal",0	; on met simplement dc.b 0
	dc.b "newmodexe",0
	even					; assure la parit‚
	
	; ici type<>0 (et donc bit #1 mis aussi!), la structure serait:

	dc.b "newmodinfo",0	; si l'un des mots n'est pas red‚fini,
	dc.b "newmodpal",0	; on met simplement dc.b 0
	dc.b "newmodexe 1",0	; les n fonctions de modexe avec chacune
	dc.b "newmodexe 2",0	; un appel contenant D0=i de 1 … n, et D1='XFOM'
	...
	dc.b "newmodexe n",0
	even					; assure la parit‚	
	
	
	
	
	; langue ordre p modinfo
	; en 4(SP)on trouve SNDB
	; sur A6 la pile FORTH
	
modinfo:
	moveq #2,d0			; Ok ou 0 pour erreur
	rts

modpal:
	moveq #2,d0			; Ok
	rts

	; sauvegarde les valeurs du FORTH
	; reloge l'‚ventuel 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 #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
	moveq #0,d0				; OK
	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
	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 4(SP):sndb

; si type<>0 d‚marrage … v‚rifier
modexe:	
	; si type<>0
	cmp.l #'XFOM',d1
	bne.s ...				; ici choisir que faire si appel direct … modexe
								; message d'erreur ou un traitement par d‚faut
	cmp #1,d0
	beq.s .fonction1
	cmp #2,d0
	beq.s .fonction2
	...
	; si type=0 
	moveq #0,d0
	bsr form_dial			; r‚serve ‚cran
.boucle_gem:
	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

	moveq #49,d0
	move.l d0,-(a6)		; num‚ro de l'objet EDIT (ann‚e)
	lea mon_arbre(pc),a0
	move.l (a0),-(a6)
	move #343,d0			; form_do
	bsr exec_forth
	bsr get_intout
	move (a0),d0			; bouton de sortie

	; ici r‚agir … D0
	bra .boucle_gem

.exit:
	moveq #3,d0				; libŠre ‚cran
	bsr form_dial
	moveq #2,d0				; valeur retour !
	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
	
find_radio:
	move.l d0,-(sp)
	move.l d0,-(a6)		; index boite
	move.l mon_arbre(pc),-(a6)	; adresse arbre
	move #904,d0
	bsr exec_forth			; getradio
	move.l (sp)+,d0
	sub.l d0,(a6)			; ramŠne … 1 le premier ‚l‚ment (mois ou jour)
	rts

	data

mon_rsc:
	INCBIN "????????.RSC"
	even
	
	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
coords: ds.l 4			; x,y,w,h de la boite
mon_arbre: ds.l 1

	end