
V1 MACRO
   if \1<128
   	moveq #\1,d0
   else
   	move #\1,d0
   endif
	moveq #\2,d1
	moveq #\3,d2
   if \4<128
   	moveq #\4,d3
   else
   	move #\4,d3
   endif
	bra vdiun
	ENDM

V2 MACRO
	if \1<128
		moveq #\1,d0
	else
		move #\1,d0
	endif
	moveq #\2,d1
	moveq #\3,d2
	moveq #\4,d3
	bra vdideux
	ENDM

V3 MACRO
	if \1<128
		moveq #\1,d0
	else
		move #\1,d0
	endif
	moveq #\2,d3
	bra vditrois
	ENDM

V4 MACRO
	moveq #\1,d0
	tst.b xy_flag
	beq vdiquatre
	ENDM

V5 MACRO
	if \1<128
   	moveq #\1,d0
   else
   	move #\1,d0
   endif
	moveq #\2,d1
	moveq #\3,d3
	bra vdicinq
	ENDM

A1 MACRO
	if \1<128
		moveq #\1,d0
	else
		move #\1,d0
	endif
	moveq #\2,d1
	moveq #\3,d2
	moveq #\4,d3
	bra aesun
	ENDM

A2 MACRO
	if \1<128
		moveq #\1,d0
	else
		move #\1,d0
	endif
	moveq #\2,d2
	bra aesdeux
	ENDM

 text
 even

kbshift: dc.l $E1B	; adresse kbshift pour TOS 1.00, chang‚e au d‚marrage sinon.

read_cookies:
	pea .find(pc)
	XBIOS 38,6
	rts
.find:
	move.l $5a0.w,d0
	beq.s .out
	move.l d0,a0
.lb0:
	move.l (a0)+,d0
	beq.s .out
	cmp.l #'_MCH',d0
	bne.s .lb1
	move.l (a0),mch_value
	cmp #6,(a0)
	seq is_saga
.lb1:
	cmp.l #'_SND',d0
	bne.s .lb2
	move.l (a0),snd_value
.lb2:
	cmp.l #'_CPU',d0
	bne.s .lb3
	move.l (a0),cpu_value
.lb3:
	cmp.l #'_APK',d0
	bne.s .lb4
	move.l (a0),apk_value
.lb4:
	addq.l #4,a0
	bra.s .lb0
.out:
	rts

; d0<>0 si mode direct autoris‚
; d5<>0 si AES autoris‚
; renvoie d0 mode ecran et d1 0/1 si compatible atari ou no

ScreenEncoding:
	lea once(pc),a0
	tst.l d0
	sne (a0)+					; if flag<>0 then direct access allowed
	sne (a0)
	GEM_VDI vq_extnd2
	move intout+8,d7		; nombre de bits/pixel
	move d7,planes
	lea mf_dest(pc),a0
	move d7,12(a0)		; pour le bloc
	lea .bits(pc),a0
	lea .table(pc),a1
	move d7,-2(a1)
.cherche:
	cmp (a0)+,d7
	beq.s .ok
	addq.l #4,a1
	bra.s .cherche
.ok:
	move.l (a1),a0
	jsr (a0)
.out:
	rts

.bits: dc.w 1,2,4,8,16,24,32
.fatal: dc.w 0
.table: dc.l mono,coul4,coul16,coul256,highcol,truecol24,truecol32,gloups

mono:
	lea .palmono(pc),a6
	bsr dessin
	move.l #$00010000,d0
	move.l (a0),d1
	cmp.l #$11111111,d1
	beq.s .ok
	bset #31,d0		; unknown
.ok:
	moveq #0,d1		; mono toujours compatible Atari
	rts
.palmono: dc.w 0,0
	dc.w 0,0,0,1

coul4:
	lea .pal4(pc),a6
	bsr dessin
	movem.l (a0),d1-d2
	move.l #$00020000,d0		; interlaced planes, 2 bits/pixel
	cmp.l #$66665555,d1
	bne.s .autre
	cmp.l d2,d1
	beq.s .ok0
.autre:
	addq.l #1,d0				; non interlaced
	cmp.l #$66666666,d1
	bne.s .gloups
	cmp.l #$55555555,d2
	beq.s .ok1
.gloups:
	bset #31,d0					; unknown
.ok0:
	moveq #0,d1					; compatible Atari
	bra.s .ok
.ok1:
	moveq #1,d1					; carte graphique
.ok:
	rts
.pal4: dc.w 0,0
	dc.w 0,1,2,3

coul16:
	lea .pal16(pc),a6
	bsr dessin
	movem.l (a0),d1-d4
	move.l #$00040000,d0		; interlaced, 4 bits/pixel
	cmp.l #$DDDD4444,d1
	bne.s .autre
	cmp.l #$CCCC3333,d2
	bne.s .autre
	cmp.l d4,d2
	bne.s .autre
	cmp.l d1,d3
	beq.s .ok0
.autre:
	addq.l #1,d0				; non interlaced
	cmp.l #$DDDDDDDD,d1
	bne.s .dernier
	cmp.l #$44444444,d2
	bne.s .dernier
	cmp.l #$CCCCCCCC,d3
	bne.s .dernier
	cmp.l #$33333333,d4
	beq.s .ok1
.dernier:
	addq.l #1,d0				; packed 2 pixels = 1 byte
	cmp.l #$57895789,d1
	bne.s .gloups
	cmp.l d4,d1
	bne.s .gloups
	cmp.l d4,d2
	bne.s .gloups
	cmp.l d4,d3
	beq.s .ok1
.gloups:
	bset #31,d0		; unknown
.ok0:
	moveq #0,d1					; compatible Atari
	bra.s .ok
.ok1:
	moveq #1,d1					; carte graphique
.ok:
	rts
.pal16: dc.w 0,0
	dc.w 7,8,9,10

coul256:
	lea .pal256(pc),a6
	bsr dessin
	move.l a0,a1
	moveq #7,d1
	move.l a1,a2
	move.l #$00080002,d0		; 1byte = 1pixel
.lb0:
	cmp.l #$10111213,(a2)+
	bne.s .autre
	dbf d1,.lb0
	bra.s .ok1
.autre:
	move.l a0,a1
	addq.l #1,d0				; 1byte=1pixel matrix
	moveq #7,d1
	move.l a1,a2
.lb1:
	cmp.l #$0F101112,(a2)+
	bne.s .lb2
	dbf d1,.lb1
	bra.s .ok1
.lb2:
	moveq #1,d1
	subq.l #3,d0				; interlaced
.verif:
	cmp.l #$55553333,(a1)+
	bne.s .gloups
	tst.l (a1)+
	bne.s .gloups
	cmp.l #$ffff0000,(a1)+
	bne.s .gloups
	tst.l (a1)+
	bne.s .gloups
	dbf d1,.verif
	bra.s .ok0
.gloups:
	bset #31,d0		; unknown
.ok0:
	moveq #0,d1					; compatible Atari
	bra.s .ok
.ok1:
	moveq #1,d1					; carte graphique
.ok:
	rts
.pal256: dc.w 0,0
	dc.w 16,17,18,19

highcol:
	lea palplus(pc),a6
	bsr dessin
	movem.l (a0),d1-d2	; 4 premiers pixels
	move.l a0,a1
	move.l #$00100000,d0	; rrrrrvvv vvvbbbbb
	bset #21,d2
	bset #21,d1
	cmp.l #$FFFFF800,d1
	bne.s .autre
	cmp.l #$07E0001F,d2
	beq.s .ok0
.autre:
	movem.l (a1),d1-d2
	addq.l #1,d0			; vvvbbbbb rrrrrvvv
	bset #29,d1
	bset #29,d2
	cmp.l #$FFFF00F8,d1
	bne.s .zotr
	cmp.l #$E0071F00,d2
	beq.s .ok1
.zotr:
	addq.l #1,d0			; xrrrrrvv vvvbbbbb
	movem.l (a1),d1-d2
	and.l #$7FFF7FFF,d1
	and.l #$7FFF7FFF,d2
	cmp.l #$7FFF7C00,d1
	bne.s .dernier
	cmp.l #$03E0001F,d2
	beq.s .ok1
.dernier:
	addq.l #1,d0			; vvvbbbbb xrrrrrvv
	movem.l (a1),d1-d2
	and.l #$FF7FFF7F,d1
	and.l #$FF7FFF7F,d2
	cmp.l #$FF7F007C,d1
	bne.s .gloups
	cmp.l #$E0031F00,d2
	beq.s .ok1
.gloups:
	bset #31,d0				; unknown
.ok0:
	moveq #0,d1					; compatible Atari
	bra.s .ok
.ok1:
	moveq #1,d1					; carte graphique
.ok:
	rts

palplus: dc.w 16,4
	dc.w 1000,1000,1000,1000,0,0,0,1000,0,0,0,1000
	dc.w 16,17,18,19

truecol24:
	lea palplus(pc),a6
	bsr dessin
.retour:
	movem.l (a0),d1-d3	; 4 premiers pixels
	move.l #$00180000,d0	; RVB
	cmp.l #-1,d1
	bne.s .autre
	cmp.l #255,d2
	bne.s .autre
	cmp.l #255,d3
	beq.s .ok0
.autre:
	addq.l #1,d0			; BVR
	cmp.l #$FFFFFF00,d1
	bne.s .gloups
	cmp.l #$00FF00FF,d2
	bne.s .gloups
	cmp.l #$00FF0000,d3
	beq.s .ok1
.gloups:
	tst.b once
	beq.s .fini
	bsr direct
	bra.s .retour
.fini:
	bset #31,d0			; unknown
	rts
.ok0:
	moveq #0,d1					; compatible Atari
	bra.s .ok
.ok1:
	moveq #1,d1					; carte graphique
.ok:
	lea once(pc),a0
	tst.b (a0)+			; first pass?
	bne.s .ok2			; yes !
	tst.b (a0)
	beq.s .ok2			; yes too
	bset #15,d0			; else set bit for direct access required
.ok2:
	rts

truecol32:
	lea palplus(pc),a6
	bsr dessin
.retour:
	movem.l (a0),d1-d4
	move.l #$00FFFFFF,d5
	move.l #$00200000,d0	; xRVB
	and.l d5,d1
	and.l d5,d2
	and.l d5,d3
	and.l d5,d4
	cmp.l d5,d1
	bne.s .autre
	cmp.l #$FF0000,d2
	bne.s .autre_sens
	cmp.l #$FF00,d3
	bne.s .autre_sens
	cmp.l #255,d4
	beq .ok0
.autre_sens:
	cmp.l #$ff,d2
	bne.s .autre
	cmp.l #$ff00,d3
	bne.s .autre
	cmp.l #$ff0000,d4
	bne.s .autre
	bra.s .ok1
	addq.l #1,d0		; xBVR
.autre:
	lea pile,a0
	movem.l (a0),d1-d4
	lsl.l #8,d5
	addq.l #2,d0		; BVRx
	and.l d5,d1
	and.l d5,d2
	and.l d5,d3
	and.l d5,d4
	cmp.l d5,d1
	bne.s .gloups
	cmp.l #$FF00,d2
	bne.s .autre_sens2
	cmp.l #$FF0000,d3
	bne.s .autre_sens2
	cmp.l #$FF000000,d4
	beq.s .ok1
.autre_sens2:
	addq.l #1,d0			; RVBx
	cmp.l #$FF000000,d2
	bne.s .gloups
	cmp.l #$ff0000,d3
	bne.s .gloups
	cmp.l #$ff00,d4
	beq.s .ok1
.gloups:
	tst.b once
	beq.s .fini
	bsr direct
	bra .retour
.fini:
	bset #31,d0			; unknown
	rts
.ok0:
	moveq #0,d1					; compatible Atari
	bra.s .ok
.ok1:
	moveq #1,d1					; carte graphique
.ok:
	lea once(pc),a0
	tst.b (a0)+			; first pass?
	bne.s .ok2			; yes !
	tst.b (a0)
	beq.s .ok2			; yes too
	bset #15,d0			; else set bit for direct access required
.ok2:
	rts

gloups:
	moveq #0,d0
	move d7,d0			; unknow number of bits/pixel
	bset #15,d0			; unknown
	swap d0			   ; in high word
	rts

; a6=palette

dessin:
	ifd LIB
		tst.b aes_flag
		beq.s .no_aes1
	endif
	move #1,wu_int
	GEM_AES wind_update
	GEM_AES form_dial2
.no_aes1:
	lea vc_int(pc),a5
	move (a6)+,(a5)
	move (a6)+,d4		; nombre
	bra.s .fin_coul
.coul:
	move (a6)+,2(a5)
	move (a6)+,4(a5)
	move (a6)+,6(a5)
	GEM_VDI vs_color2
	addq #1,(a5)
.fin_coul:
	dbf d4,.coul
	moveq #3,d6
	lea vm_int(pc),a5
.points:
	move (a6)+,(a5)		; couleur!
	GEM_VDI vsm_color2
	GEM_VDI v_pmarker2
	lea vp_int(pc),a0
	moveq #7,d0
.trans:
	addq #1,(a0)
	addq.l #4,a0
	dbf d0,.trans
	dbf d6,.points
	GEM_VDI vro_cpyfm2		; remplit le bloc!!!
	ifd LIB
		tst.b aes_flag
		beq.s .no_aes2
	endif
	clr wu_int
	GEM_AES wind_update
	move #3,fd_int
	GEM_AES form_dial2
.no_aes2:
	lea pile,a0		; le bloc!!!
	rts

direct:
	XBIOS 3,2				; physbase
	move.l d0,a1
	lea pile,a2
	move.l a2,a0
	move table-2(pc),d0	; 24 octets ou 32 a lire
	subq #1,d0
.copy:
	move.b (a1)+,(a2)+
	dbf d0,.copy
	sf once
	rts

	; cherche un mot dans le dictionnaire
	; … la fois lors de la compilation
	; mais aussi lors de la cr‚ation d'un nouveau mot
	; pour s'assurer qu'il n'y a pas de red‚finition
	; et ‚galement dans modload pour red‚finir les appels
	; le mot dans mot
	; sa taille dans d1.b

find_word:
			lea ordres,a3
         moveq #0,d2
.autre:  move.b (a3)+,d2
         beq .findic
         cmp.b d1,d2
         beq.s .voyons
.bennon: add.l d2,a3
         addq.l #1,d4
         bra.s .autre
.voyons: move.l #mot,a4
         move d2,d7
         subq #1,d7
         move.l a3,a5
.lab6:   cmp.b (a4)+,(a5)+
         dbne d7,.lab6
         bne.s .bennon
.findic:
			tst.b d2				; renvoie EQ si fin du dictionnaire
			rts					; NE (et >0) si mot trouv‚


vq_extnd2: dc.l ve_cont,ve_int,dum,intout,ptsout
ve_cont: dc.w 102,0,0,1,0,0,0,0,0,0,0,0
ve_int: dc.w 1

vsm_color2: dc.l vm_cont,vm_int,dum,dum,dum
vm_cont: dc.w 20,0,0,1,0,0,0,0,0,0,0,0
vm_int: dc.w 0

v_pmarker2: dc.l vp_cont,dum,vp_int,dum,dum
vp_cont: dc.w 7,8,0,0,0,0,0,0,0,0,0,0
;vp_cont: dc.w 7,1,0,0,0,0,0,0,0,0,0,0
vp_int: dc.w 0,100,4,100,8,100,12,100,0,101,4,101,8,101,12,101

form_dial2: dc.l fd_cont,global,fd_int,dum,dum,dum
fd_int: dc.w 0,0,0,16,2,0,100,16,2

vs_color2: dc.l vc_cont,vc_int,dum,dum,dum
vc_cont: dc.w 14,0,0,4,0,0,0,0,0,0,0,0
vc_int: dc.w 0,0,0,0

vro_cpyfm2: dc.l cp_cont,cp_int,cp_ptsin,dum,dum
cp_cont: dc.w 109,4,0,1,0,0,0
	dc.l mf_source,mf_dest
cp_int: dc.w 3
cp_ptsin: dc.w 0,100,15,101,0,0,15,1
mf_source: dc.l 0,0,0,0,0
mf_dest: dc.l pile
		dc.w 16,2,1,0,0,0,0,0

code_ecran:
once: dc.w 0,0

	SAUT
graphic_card:
	move.l gcard,-(a6)
	rts

	SAUT
screen_info:
	move.l code_ecran(pc),-(a6)
	rts

test_mxalloc:
	GEMDOS 48,2			; sversion
	cmp.l #$1900,d0
	spl is_mxal			; FF if mxalloc exists
	rts
is_mxal: dc.w 0

le_menu:
   move.l pilptr,a6
	move.l #menu_chaine,-(a6)
	bsr menu
	move.l (a6)+,menu_adresse
	move.l topprg,program      ; avance le d‚but du dicco, partie r‚serv‚e
	rts

	dc.w 9
menu_chaine: dc.b "  FORTH  ",0
   dc.w 9
   dc.b 0,0,0,0,0,0,0,0,0,0
   dc.w 9
   if LANG=0
   	dc.b "  Retour",0,0
   else
   	dc.b "  Return",0,0
   endif
   dc.w 9
   dc.b 0,0,0,0,0,0,0,0,0,0

menu_adresse: dc.l 0

control: dcb.w 13,0
; edb: dc.l edbuf

; edition d'une chaine en A0
; d6 = nombre maxi de caractŠres accept‚s
; si d6 est n‚gatif, c'est qu'il faut tenir compte de la position D4/D7
; de la fenetre ouverte sur le texte
; les donn‚es de la fenetre sont dans (fenetre)
; la liste des touches de sortie est dans [end_keys]
; utilise a0,a1,a3 et d0,d1,d3,d4,d5,d7
; d6 non modifi‚
; renvoit D0 code ‚tendu de la touche de sortie
; et d4 position du curseur lors de la sortie

edition:
	tst screen_percent	; si <>0
	bne.s .prg				; edition VDI en fenetre
								; sinon ici, utilisation du TOS
	subq.l #2,a0			; retour sur la taille
	move d6,d0
	and #$7F,d0
	cmp d6,d0
	beq.s .moins
	move #127,d0			; limit‚ … 127 caractŠres
.moins:
	move.b d0,(a0)+		; taille maxi
	pea (a0)
	clr.b (a0)+				; recevra le nombre d'octets lus
	pea -2(a0)
	GEMDOS 10,6				; read string
	moveq #0,d0
	move.l (sp)+,a0
	move.b (a0)+,d0		; taille lue
	clr.b 0(a0,d0.l)		; met un z‚ro final
	move d6,-(a0)			; et remet la taille normale
	rts
.prg:
	move #10,copy_int          ; mode NOT DEST ( pour le curseur )
   move.l a0,a3
   tst.l d6
   bpl.s .lb_0
   move d7,d0                 ; si d6 n‚gatif, d4 et d7 d‚j… charg‚s
   add d4,d0
   neg.l d6                   ; laisser une instruction NE avant le bra
   bra.s .lb_x
.lb_z:
   tst.b (a0)+
.lb_x: dbeq d0,.lb_z           ; v‚rifie la validit‚ de D4 et D7
   bne.s .lb_1
.lb_0:                        ; si D6 positif, curseur au d‚but
   moveq #0,d7                ; d‚but de la fenetre dans la chaine
   moveq #0,d4	               ; offset du curseur dans la fenetre
.lb_1:
	clr.b 0(a0,d6.w)           ; s'assure de d6 caractŠres au maximum
	addq #1,d6                 ; tenir compte du curseur en bout de ligne
	if STE=0
		lea ([fenetre,pc],8),a0    ; pointe sur x,y,l,h
	else
		move.l fenetre(pc),a0
		addq.l #8,a0
	endif
	move.l (a0)+,d1
	move.l (a0),d3             ; l et h
	move.l fenetre(pc),a1      ; pointe sur X,Y,L,H
	add.l (a1)+,d1
	move.l d1,vt_pts           ; coordonn‚es pour le texte
	move (a1),d5               ; L
	sub -4(a0),d5              ; L-x
	ext.l d5
	swap d3
	divs d3,d5                 ; nombre de caractŠres dans la fenˆtre
	cmp d5,d4                  ; curseur dans fenetre ?
	bmi.s .lb_y
	moveq #0,d4                ; non, on annule tout !
	moveq #0,d7
.lb_y:
	cmp d5,d6
   bpl.s .lb0
   move d6,d5                 ; fenˆtre impos‚e plus petite que l'‚cran
.lb0: move d5,vt_cont+6       ; nombre de caractŠres … afficher
   subq #1,d6
.aff:
   lea 0(a3,d7.w),a0
	move d5,d0
	lea vt_int,a1
	moveq #0,d1
.lb1: subq #1,d0              ; la fenetre jusqu'au bout
   bmi.s .lb3
	move.b (a0)+,d1            ; ou jusqu'au caractŠre nul
	beq.s .lb2
	move d1,(a1)+
	bra.s .lb1
.lb2: move #32,(a1)+          ; on comble avec des espaces si il le faut
   dbf d0,.lb2
.lb3: GEM_VDI vdi_text
   clr.l mf1
   clr.l mf2
   move d4,d0
   muls d3,d0                 ; offset curseur en points
   swap d0
   add.l vt_pts,d0
   lea copy_pts,a1
   move.l d0,(a1)+
   move.l d3,d1
   swap d1
   sub.l #$10001,d1
   add.l d0,d1
   move.l d1,(a1)+
   move.l d0,(a1)+
   move.l d1,(a1)
   GEM_VDI copy_tab
.touche:
	ifd LIB					; pour forth.lib
		tst.b aes_flag
		bne.s .touche0
		.touche1:
			move #255,-(sp)
			GEMDOS 6,4		; touche?
			move.l d0,d1
			beq.s .touche1
		swap d1
		lsl.w #8,d1			; code clavier dans octet fort
		or d1,d0				; clavier+ASCII
	   bra.s .touche2
	   .touche0:
	endif
	GEM_AES event_key
   move i_intout,d0
   cmp.b #$1b,d0
   bne.s .touche2
   move.w #$11b,d0
.touche2:
	cmp #$0F09,d0			; touche TAB ?
	bne.s .touche3
	move.l kbshift,a0
	move.b (a0),d1			; si TAB, ajoute l'info
	and #3,d1				; Shift droit et gauche
	ror #4,d1				; 0000 ou 1000 ou 2000 ou 3000 selon les touches
	or d1,d0					; masque ajout‚ … $0F09
.touche3:
   move.l end_keys,a0
   move (a0)+,a1       ; reaction pour BACKSPACE
.is_fin:
   move (a0)+,d1
   beq.s .pasfin
   cmp d0,d1
   bne.s .is_fin
   beq .fin
.pasfin:
   cmp #$4b00,d0       ; gauche
   bne.s .k0
      subq #1,d4
      bpl .lb3            ; encore dans la fenetre
      moveq #0,d4
      subq #1,d7          ; sinon, d‚cale la fenetre
      bpl .aff
      moveq #0,d7         ; on ‚tait d‚j… au d‚but !
      bra.s .touche
.k0:
   cmp #$4b34,d0     ; shift gauche
   bne.s .k1
      moveq #0,d7
      moveq #0,d4
      move.l a3,a0
   .k01:
      cmp.b #32,(a0)+ ; avance au premier caractŠre non blanc
      bne.s .k02
      addq #1,d4      ; sinon avance
      cmp d5,d4       ; fenetre d‚pass‚e?
      bmi.s .k01
      subq #1,d4      ; oui, on revient dedans
      addq #1,d7      ; et on avance le fenetre
      bra.s .k01
   .k02:
   	tst.b -(a0)		; ce caractŠre est-il z‚ro?
   	bne .aff			; non, donc on a bien trouv‚ qq chose
   	moveq #0,d7		; sinon, ligne vide
   	moveq #0,d4		; on revient au d‚but
   	bra .aff
.k1:
	cmp #$4d00,d0     ; droite
	bne.s .k2
	   move d7,d0
	   add d4,d0      ; l… ou on en est dans la chaine
	   tst.b 0(a3,d0.w)
	   beq .touche  ; d‚j… sur le z‚ro terminal
	   addq #1,d4     ; sinon on peut avancer
	   cmp d5,d4
	   bmi .lb3       ; encore dans la fenetre
	   move d5,d4
	   subq #1,d4
	   addq #1,d7     ; on d‚cale la fenetre
	   bra .aff
.k2:
   cmp #$4d36,d0     ; shift droite
   bne.s .k3
      move d7,d0
      add d4,d0      ; on en est l…
      lea 0(a3,d0.w),a0
      moveq #0,d1		; ‚vite l'espace au d‚part
   .k21:
   	cmp.b #32,d1	; si espace on ne retient pas d4/d7
   	beq.s .k20
   	move d4,d0		; sinon, garde d4/d7 derniŠre position non vide
   	swap d0
   	move d7,d0
   .k20:
   	move.b (a0)+,d1
   	beq .k22
   	addq #1,d4     ; sinon on se d‚cale
   	cmp d5,d4
   	bmi.s .k21     ; toujours dans la fenetre
   	subq #1,d4
   	addq #1,d7     ; sinon, c'est la fenetre qu'on d‚cale
   	bra.s .k21
   .k22:
   	move d0,d7
   	swap d0
   	move d0,d4
   	bra .aff
.k3:
	cmp.b #$1b,d0     ; escape
	bne.s .k4
	   moveq #0,d4
	   moveq #0,d7
	   clr.b (a3)
	   bra .aff
.k4:
	cmp #$537f,d0     ; delete
	bne.s .k5
	.k41:
   	move d7,d0
   	add d4,d0
   	lea 0(a3,d0.w),a0
   	tst.b (a0)     ; d‚j… la fin?
   	beq .touche
   .k40:
   	move.b 1(a0),(a0)+
   	bne.s .k40
   	bra .aff
.k5:
	cmp #$0e08,d0     ; backspace
	bne.s .k6
      subq #1,d4
      bpl.s .k41     ; comme pour delete
      moveq #0,d4
      subq #1,d7
      bpl.s .k41
      moveq #0,d7    ; on est sur la premiŠre colonne
      cmp #0,a1
      beq .touche    ; mode direct, pas de sortie
      bra .fin
.k6:
	cmp.b #13,d0      ; enter
	bne.s .k7
		bra .fin
.k7:
	cmp #$0f09,d0     ; TAB
	bne.s .k8
		moveq #0,d1
		move d7,d1
		add d4,d1      ; on en est l…
	   lea 0(a3,d1.l),a0	; on pointe l…
		divs #3,d1
		addq #1,d1
		muls #3,d1		; on avance jusqu'au paquet de 3 suivant
		cmp d6,d1
	   bpl .touche    ; impossible, c'est complet!
	   sub d7,d1
	   sub d4,d1		; nombre de caractŠres … ajouter
	   moveq #0,d0    ; encore dans la fenetre
	   bra.s .k73		; commence la boucle
	.k71:
		tst.b (a0)     ; y avait-il d‚j… des caractŠres?
		bne.s .k72
		move.b #32,(a0); si non, on met des espaces
		clr.b 1(a0)
   .k72:
      addq.l #1,a0
   	addq #1,d4     ; avance
	   cmp d5,d4
	   bmi.s .k73     ; encore dans la fenetre
	   moveq #1,d0    ; plus dans la fenetre
	   move d5,d4
	   subq #1,d4
	   addq #1,d7     ; on d‚cale la fenetre
	.k73:
	   dbf d1,.k71
	   tst d0
	   beq .lb3
	   bra .aff
.k8:
   and #$ff,d0       ; ne garde que le code ASCI
	cmp #32,d0
	bmi .touche       ; code en dessous de l'espace
      move d7,d1
      add d4,d1
      cmp d6,d1
      bpl .touche    ; c'est complet !
      lea 0(a3,d1.w),a0
   .k80:
      move.b (a0),d1
      move.b d0,(a0)+
      beq .k81       ; fini? on va … droite
      move.b d1,d0
      bra.s .k80
   .k81:
      addq #1,d4     ; avancer
	   cmp d5,d4
	   bmi .aff       ; encore dans la fenetre
	   move d5,d4
	   subq #1,d4
	   addq #1,d7     ; on d‚cale la fenetre
	   bra .aff
.fin:
   ; garde d4,d7 intacts: position du curseur!
   move d0,-(sp)
   ifnd LIB
   	move.l end_keys,a0
   	cmp.l #edit_list,a0	; sommes nous sous l'‚diteur?
		bne.s .f4   			; non
   	move.l a3,-(sp)
   	jsr _texte_effet		; sinon traiter les effets
   	.f4:
   endif
   move.l a3,a0      ; la chaine au d‚but
	move d5,d0        ; taille de la fenetre
	lea vt_int,a1
	moveq #0,d1
.f1: subq #1,d0              ; la fenetre jusqu'au bout
   bmi.s .f3
	move.b (a0)+,d1            ; ou jusqu'au caractŠre nul
	beq.s .f2
	move d1,(a1)+
	bra.s .f1
.f2: move #32,(a1)+          ; on comble avec des espaces si il le faut
   dbf d0,.f2
.f3: GEM_VDI vdi_text  ; pour virer le curseur
	move (sp)+,d0
	rts

nova_init:                   ; doit conserver D0.l intact
	move.l $5a0.w,a0
	cmp.l #0,a0
	beq.s .non
.boucle:
   tst.l (a0)
   beq.s .non
   cmp.l #"MiNT",(a0)
   bne.s .lb0
   move #1,mint_flag
   addq.l #8,a0
   bra.s .boucle
.lb0:
	cmp.l #"IMNE",(a0)+
	beq.s .oui
	addq.l #4,a0
	bra.s .boucle
.oui: move #1,nova_flag
   move.l (a0)+,nova_icb
   bra.s .boucle
.non: rts

nova_flag: dc.w 0
nova_icb: dc.l 0
nova_plot: dc.w $ffff
mint_flag: dc.w 0

cookie_flag: dc.w 0
cookie_val: dc.l 0

	NON
cookie:
	move #0,cookie_flag  ; par d‚faut, il n'existe pas
   move (a5),d1
	lea ordres,a0
	moveq #0,d2
	bra.s .lb1
.lb0:
	move.b (a0)+,d2      ; longueur du mot
	add.w d2,a0          ; saute le mot
.lb1:
	dbf d1,.lb0
	cmp.b #4,(a0)+       ; le cookie doit avoir 4 lettres
	bne.s .non
	lea mot,a1
	move.b (a0)+,(a1)+
	move.b (a0)+,(a1)+
	move.b (a0)+,(a1)+
	move.b (a0),(a1)     ; copie les 4 lettres dans mot
	pea _cookie
	XBIOS 38,6           ; remplit cookie_flag et cookie_val
.non:
	move.l topprg,a2
   move (a5)+,d0
   if STE=0
   	move.l a2,(adresse,d0.w*4)
   else
   	lea adresse,a0
   	asl #2,d0
   	add d0,a0
   	move.l a2,(a0)
   endif
	move #437,(a2)+
	tst cookie_flag
	bne.s .oui
	move.l .nul,(a2)+
	bra.s .fin
.oui:
	lea .ddd(pc),a0
	move (a0),(a2)+    ; move.l #...,-(a6)
	addq.l #6,a0
	move.l cookie_val,(a2)+
	move.l (a0)+,(a2)+
	move (a0),(a2)+
.fin:
	move.l a2,topprg
	bsr cache_off
	rts
.nul: clr.l -(a6)
	rts
.ddd: move.l #"COOK",-(a6)
	moveq #1,d0
	move.l d0,-(a6)
	rts

_cookie:
	move.l $5a0.w,a0
	cmp.l #0,a0
	beq.s .non
   move.l mot,d0       ; le mot sur 4 octets
.boucle:
   tst.l (a0)
   beq.s .non
   cmp.l (a0)+,d0
   beq.s .lb0          ; trouv‚!
   addq.l #4,a0        ; saute la valeur
   bra.s .boucle
.lb0:
	move #1,cookie_flag
	move.l (a0),cookie_val
.non: rts

   ASS 0
empile: move.l (a5)+,-(a6)
   rts

	NON
thvayab:
	bsr ttt
	move #530,(a2)+		; code [thv]
	move.l (a6)+,d0
	move d0,(a2)+			; taille donn‚es
	move.l (a6)+,d1		; nombre de threads
	cmp #4,d0				; au dela de 4 octets/var considŠre que ‡a peut ˆtre une chaine
	bpl.s .string_init	; donc on ajoute les mlen … tout hasard.
	muls d0,d1
	add.l d1,a2				; r‚serve la place!
	bra.s .pair
.string_init:				; seul l'‚l‚ment z‚ro aura un mlen fauss‚, on prend le risque...
	subq #3,d0				; moins z‚ro final et taille
	bra.s .lb1
.lb0:
	lea 1(a2,d0.w),a2
	move d0,(a2)+			; stocke mlen
	clr.b (a2)				; chaine vide
.lb1:
	dbf d1,.lb0
.pair:
	move.l a2,d0
	addq.l #1,d0			; aligne le pointeur sur 2
	bclr #0,d0
	move.l d0,(a0)			; met … jour le dicco
	rts

   NON
vayab: bsr ttt
   bne.s .lb0				; dans une structure
   move #140,(a2)+
   clr.l (a2)+
   move.l a2,(a0)
   rts
.lb0: clr.l (a3)+
   move.l a3,(a1)
   bra spass
spvar: move.l (a6),a0
   move.l (a0),a0
   dc.w $d1fc
   move.l a0,(a6)
   rts

_appl_getinfo: dc.l agi_cont,global,agi_int,agi_intout,addrin,dum
agi_cont: dc.w 130,1,1,4,0
agi_int: dc.w 4

appl_init: dc.l ai_cont,global,dum,appl_id,dum,dum
ai_cont: dc.w 10,0,1,0,0
appl_id: dc.w 0

appl_exit: dc.l ae_cont,global,dum,intout,dum,dum
ae_cont: dc.w 19,0,1,0,0

graf_hand: dc.l gh_cont,global,dum,intout,dum,dum
gh_cont: dc.w 77,0,5,0,0

mouse_form: dc.l mf_cont,global,mf_int,intout,dum,dum
mf_cont: dc.w 78,1,1,1,0
mf_int: dc.w 0

hide_mouse: dc.l hm_cont,dum,dum,dum,dum
hm_cont: dc.w 123,0,0,0,0,0,0,0,0,0,0,0

show_mouse: dc.l sm_cont,sm_int,dum,dum,dum
sm_cont: dc.w 122,0,0,1,0,0,0,0,0,0,0,0
sm_int: dc.w 1

vq_mouse: dc.l vq_cont,dum,dum,vq_out,vq_out+2
vq_cont: dc.w 124,0,0,0,0,0,0,0,0,0,0,0
vq_out: dc.w 0,0,0

open_work: dc.l ow_cont,ow_int,dum,work_out,ptsout
ow_cont: dc.w 100,0,0,11,0,0,0,0,0,0,0,0
ow_int: dc.w 2,1,1,1,1,1,1,0,1,0,2

close_work: dc.l cw_cont,dum,dum,dum,dum
cw_cont: dc.w 101,0,0,0,0,0,0,0,0,0,0,0

	ifd LIB	; en liaison avec >accname pour la librairie
menu_reg: dc.l mr_cont,global,appl_id,acc_id,mr_addrin,dum
mr_cont: dc.w 35,1,1,1,0
mr_addrin: dc.l acc_name
	else		; l'appel sous multitos dans le FORTH
menu_reg: dc.l mr_cont,global,appl_id,dum,menu_nom,dum
mr_cont: dc.w 35,1,1,1,0
menu_nom: dc.l _menu_nom
	endif

wind_get0: dc.l wg_cont,global,wg_int,wg_out,dum,dum
wg_cont: dc.w 104,2,5,0,0
wg_int: dc.w 0,4
wg_out: dc.w 0,0,100,16,2		; valeurs pour ScreenEncoding au d‚marrage
wg_out_sav: dc.w 0,0,0,0		; ne pas s‚parer de wg_out
maxi_xylh: dc.w 0,0,0,0

wind_get1: dc.l wg_cont,global,wg_int,w_travail,dum,dum
w_travail: dc.w 0,0,0,0,0

wind_set: dc.l ws_cont,global,ws_int,dum,dum,dum
ws_cont: dc.w 105,6,1,0,0
ws_int: dc.w 0,0,0,0,0,0

wind_calc: dc.l wca_cont,global,vt_int+16,vt_int+28,dum,dum
wca_cont: dc.w 108,6,5,0,0

wind_update: dc.l wu_cont,global,wu_int,dum,dum,dum
wu_cont: dc.w 107,1,1,0,0
wu_int: dc.w 0

wind_mask: dc.w $129

wind_create: dc.l wc_cont,global,wg_out,w_hand,dum,dum
wc_cont: dc.w 100,5,1,0,0
w_hand: dc.w -1            ; n‚gatif tant qu'aucune n'est ouverte...
w_hand_sav: dc.w 0

wind_open: dc.l wo_cont,global,wg_out,dum,dum,dum
wo_cont: dc.w 101,5,1,0,0

wind_close: dc.l wl_cont,global,w_hand,dum,dum,dum
wl_cont: dc.w 102,1,1,0,0

wind_del: dc.l wd_cont,global,w_hand,dum,dum,dum
wd_cont: dc.w 103,1,1,0,0

wind_set_title: dc.l wst_cont,global,wst_in,dum,dum,dum
wst_cont: dc.w 105,6,1,0,0
wst_in: dc.l 2,w_titre,0

copy_tab: dc.l copy_cont,copy_int,copy_pts,dum,dum
copy_cont: dc.w 109,4,0,1,0,0,0
           dc.l mf1,mf2
copy_int: dc.w 3

fill_rect: dc.l fr_cont,dum,copy_pts,dum,dum
fr_cont: dc.w 114,2,0,0,0,0,0,0,0,0,0,0

event_key: dc.l ek_cont,global,dum,i_intout,dum,dum
ek_cont: dc.w 20,0,1,0,0

event_mesag: dc.l em_cont,global,dum,dum,em_addr,dum
em_cont: dc.w 23,0,1,1,0
em_addr: dc.l vt_int

text_align: dc.l ta_cont,ta_int,dum,intout,dum
ta_cont: dc.w 39,0,0,2,0,0,0,0,0,0,0,0
ta_int: dc.w 0,5

text_attributes: dc.l tat_con,dum,dum,ta_intout,ta_ptsout
tat_con:	dc.w 38,0,0,0,0,0,0,0,0,0,0,0
ta_intout: dc.w 0,0,0,0,0,0
ta_ptsout: dc.w 0,0,0,0

vdi_text: dc.l vt_cont,vt_int,vt_pts,dum,dum
vt_cont: dc.w 8,1,0,256,0,0,0,0,0,0,0,0
vt_pts: dc.w 0,0

fenetre: dc.l fenetre0

; X,Y,L,H puis x,y ( curseur ) l,h ( caractŠre ) puis d‚coupage col,ligne
; puis 6 r‚els pour la fenˆtre math‚matique

fenetre0: dc.w 0,0,0,0,0,0,0,0,1,1
	dc.w $c024,0,0,0	; xmin = -10
	dc.w $4034,0,0,0	; xmax-xmin = 20
	dc.w $4024,0,0,0	; ymax = +10
	dc.w $c034,0,0,0	; ymin-ymax = -20
	dc.w $c024,0,0,0	; zmin
	dc.w $4034,0,0,0	; zmax-zmin

	; ne pas s‚parer de fenˆtre zero
_menu_nom: dc.b "  FORTH "
	VERSION
	dc.b 0,0
   even

	ifnd LIB					; seulement dans l'interpr‚teur
souris_visible:
	tst.b mouse_on
	beq.s .exit
	GEM_VDI show_mouse
.exit:
	rts

	SAUT
ver: move.l #.chaine,a0	; ici aussi, seulement sous l'interpr‚teur
	bsr write_str
	bsr cr
	lea .tailles(pc),a0
	bsr write_str
	bsr cr
	lea .nom(pc),a0
	move.l #fin_new_names,d0
	sub.l sommet,d0
	bsr.s .ligne
	lea .addr(pc),a0
	move.l #(fin_new_adr-adresse)/4,d0	; nombre total d'adresses possibles
	move forth,d1
	ext.l d1
	sub.l d1,d0									; moins les existantes
	bsr.s .ligne
	rts
.ligne:
	move.l a0,-(a6)
	move.l d0,-(a6)
	lea .esp(pc),a0
	bsr write_str
	bsr dpt
	move.l (a6)+,a0
	bsr write_str
	bsr cr
	rts
.chaine:
	IF STE=1
		dc.b " STE "
	else
		dc.b " TT "
	endif
	VERSION
	dc.b " ("
	DATE
	dc.b ")",0
.esp: dc.b 32,250,32,0
	if LANG=0
.tailles: dc.b " Pour les mots nouveaux, reste :",0
.nom: dc.b " octets pour les noms",0
.addr: dc.b " adresses libres.",0
	else
.tailles: dc.b " Remaining size for the new words :",0
.nom: dc.b " bytes for the names",0
.addr: dc.b " free addresses.",0
	endif
	even

	else

	SAUT
ver: rts

	endif

version_init:
	lea _menu_nom+8(pc),a0		; pointe sur VERSION
	moveq #0,d0
.lb0:
	move.b (a0)+,d1
	beq.s .fin
	cmp.b #'.',d1					; s‚parateur?
	bne.s .chiffre
	lsl.l #8,d0						; si s‚parateur, change de byte
	bra.s .lb0
.chiffre:
	lsl.b #4,d0						; d‚cale d'un nibble
	sub.b #'0',d1					; 0-9
	or.b d1,d0						; et ajoute le nouveau chiffre
	bra.s .lb0
.fin:
	move.l d0,extra_data+16		; rang‚ !
	rts


fastopen:
	tst screen_percent		; programme TOS? (si =0)
	beq.s .exit					; oui, rien … faire !
	move w_hand,d7
	ifd LIB
	   bpl.s .lb0				; programme compil‚, la cr‚ation n'est pas automatique
		bsr.s fastcreate		; donc on la force en cas...
		.lb0:
		tst.b aes_flag			; si AUTO, on saute les appels AES
		beq.s .lb1
	endif
	lea wg_out,a0
	move d7,(a0)+
	move.l 8(a0),(a0)+		; r‚cupŠre les donn‚es de sav
	move.l 8(a0),(a0)
	GEM_AES wind_open
   move d7,wg_int
	GEM_AES wind_get1
.lb1:
   move.l #fenetre0,a0
   move.l a0,-(a6)
   lea w_travail+2,a1
   move.l (a1)+,(a0)+
   move.l (a1)+,(a0)+
   bsr setp
	bsr cls
	GEM_VDI text_align         ; point en haut … gauche
	st w_flag					; signale qu'elle est ouverte
.exit:
	rts


fastcreate:
	ifd LIB
		tst.b aes_flag						  ; seulement dans FORTH.LIB
		beq .auto
	endif
	moveq #4,d0
	move.l d0,wg_int						; fenetre 0, fonction 4= zone de travail
	GEM_AES wind_get0
	lea wg_out,a0
	move wind_mask,(a0)+					; nom+mover+sizer
	move.l (a0)+,d0						; x,y
	move.l (a0),d1							; l,h
	move screen_percent,d7
	moveq #100,d6
	cmp d6,d7
	bmi.s .lb0								; <100 ok
	move d6,d7								; else limit !
.lb0:
	move d1,d2								; h
	muls d7,d2
	divs d6,d2								; new h*n%
	sub d2,d1
	lsr #1,d1								; (H-h)/2
	add d1,d0								; new Y = y + (H-h)/2
	move d2,d1								; replace new h
	swap d1
	swap d0
	move d1,d2								; l
	muls d7,d2
	divs d6,d2								; new l*n%
	sub d2,d1
	lsr #1,d1								; (L-l)/2
	add d1,d0								; new X = x + (L-l)/2
	move d2,d1								; replace new l
	swap d0
	swap d1
	move.l d1,(a0)						; l,h
	move.l d1,8(a0)					; dans wg_out_sav
	move.l d0,-(a0)					; x,y
	move.l d0,8(a0)					; dans sav
	GEM_AES wind_create
	move w_hand,d7
   move d7,wst_in
   move d7,ws_int
   GEM_AES wind_set_title
   rts

	ifd LIB
.auto:
	if STE=1
		jsr ouvre_vdi
	else
		bsr.l ouvre_vdi
	endif
	move #1,w_hand					; handle fictif
	GEM_VDI text_attributes
	lea fenetre0,a0
	move.l a0,-(a6)
	clr.l (a0)+						; X=Y=0 d‚part de l'‚cran
	move.l work_out,(a0)			; L-1, H-1
	add.l #$10001,(a0)+			; L H
	clr.l (a0)+						; x=y=0, curseur en haut
	move.l ta_ptsout+4,(a0)		; l,h d'un caractŠre
	lea -12(a0),a0
	lea w_travail+2,a1
	move.l (a0)+,(a1)+			; simule l'appel … w_get1
	move.l (a0)+,(a1)+
	bsr setp
	bsr cls
	GEM_VDI text_align
	rts
	endif

fastclose:
	tst.b w_flag
	beq.s .fin
	ifd LIB
		tst.b aes_flag
		beq.s .fin
	endif
   GEM_AES wind_close
   sf w_flag						; signale ferm‚e
.fin:
   rts

fastdel:
	tst w_hand
	bmi.s .fin
	ifd LIB
		tst.b aes_flag
		beq.s .fin
	endif
   GEM_AES wind_del
   move #-1,w_hand				; fenetre d‚truite
.fin:
	rts

	; remplit les valeurs maxi pour une fenetre

get_xylh:
   clr wg_int
	GEM_AES wind_get0
	lea wg_out+2,a0
	lea maxi_xylh,a1						; taille max pour ma fenetre
	move.l (a0)+,(a1)+					; x,y
	move.l (a0),(a1)						; l,h
	rts



	SAUT
fasthdl:
	ifd LIB
		moveq #0,d7
		move w_hand,d7
	   bpl.s .lb0				; programme compil‚, la cr‚ation n'est pas automatique
		bsr fastcreate			; donc on la force en cas...
		.lb0:
		move.l d7,-(a6)
	else
		move w_hand,a0
		move.l a0,-(a6)
	endif
	rts

; a0 pointe sur la chaine se terminant par 0
; les coordonn‚es du curseur sont dans la structure fenetre
; utilise d0,d1,d2,d3,d4, a0,a1,a2
; si il y a un saut de ligne (cr), utilise d5,d6,d7 en plus !

write_str:
	tst screen_percent			; si <>0
	bne.s .normal					; sortie VDI en fenetre
	pea (a0)							; sinon, programme TOS
	GEMDOS 9,6						; sortie plein ‚cran
	rts
.normal:
   moveq #0,d1                ; nombre de caractŠres
	lea vt_int,a1
	moveq #0,d0
	if STE=0
		lea ([fenetre,pc],8.w),a2
	else
		move.l fenetre(pc),a2
		addq.l #8,a2
	endif
	move.l (a2)+,d2              ; x et y
	move.l d2,vt_pts
	swap d2                      ; reprend x
	move (a2),d3                 ; l
	move.l fenetre(pc),a2
   move.l (a2)+,d4
	add.l d4,vt_pts
	move (a2),d4                 ; L
.autre:
   add d3,d2							; x+l (ajoute un caractŠre)
   cmp d2,d4							; compar‚ … largeur maxi?
   bpl.s .place						; assez de place encore !
   tst.b (a0)                   ; mais, sommes nous … la fin?
   beq.s .fin
   move d1,vt_cont+6            ; nombre de caractŠres
   move.l a0,-(sp)
   GEM_VDI vdi_text					; ‚crit jusqu'… la fin de la ligne physique
   bsr cr								; saute un ligne
   move.l (sp)+,a0
   bra.s write_str					; poursuit l'‚criture
.place:
   move.b (a0)+,d0              ; caractŠre suivant
   beq.s .fin
   addq #1,d1							; un caractŠre de plus
   move d0,(a1)+						; dans vt_int
   bra.s .autre
.fin:
	move d1,vt_cont+6
   sub d3,d2
	if STE=0
		move d2,([fenetre],8.w)     ; actualise x
	else
		move.l fenetre,a0
		move d2,8(a0)
	endif
	GEM_VDI vdi_text
	rts

   NON
page: bsr ttt
   bne.s .lb0
   move #140,(a2)+
   add.w #68,a2
   move.l a2,(a0)
   rts
.lb0: add.w #68,a3
   move.l a3,(a1)
   bra spass

   NON
const: bsr.s ttt
   bne.s .lb0
   move #141,(a2)+
   move.l (a6)+,(a2)+
   move.l a2,(a0)
   rts
.lb0: move.l (a6)+,(a3)+
   move.l a3,(a1)
   move.l #.lb1,a1
   move.l (a1)+,(a2)+
   move (a1)+,(a2)+
   move.l d4,(a2)+
   move.l (a1)+,(a2)+
   move.l a2,(a0)
   rts
.lb1: move.l (a6),a0
   move.l (a0),a0
   dc.w $d1fc
   move.l (a0),(a6)
   rts

   NON
array: bsr.s ttt
   beq.s .lb2				; array simple? sauter
	move.l (a6)+,d1		; ici dans une structure
   subq.l #1,d1
.lb3: clr.l (a3)+
   dbf d1,.lb3
   move.l a3,(a1)
   move.l #.lb4,a1
   move.l (a1)+,(a2)+
   move (a1)+,(a2)+
   subq.l #4,d4
   move.l d4,(a2)+
   move.l (a1)+,(a2)+
   move.l (a1)+,(a2)+
   move (a1),(a2)+
   move.l a2,(a0)
   rts
.lb4: move.l (a6)+,a0
   move.l (a0),a0
   dc.w $d1fc
   move.l (a6),d1
   lsl.l #2,d1
   add.l d1,a0
   move.l a0,(a6)
   rts
.lb2:
   move #142,(a2)+
   move.l (a6)+,d1
   subq.l #1,d1
.lb1: clr.l (a2)+
   dbf d1,.lb1
   move.l a2,(a0)
   rts

ttt: move (a5)+,d4		; nom de la variable/tableau/chaine
   ext.l d4
   lsl.l #2,d4
   lea adresse,a3
   add.l d4,a3				; A3 pointe sur le LONG de sa d‚finition
   lea topprg,a0
   move.l (a0),a2
   move.l a2,(a3)			; met topprg dans sa def
   tst stt					; une structure?
   beq.s .fin				; non... on quitte
   move #437,(a2)+
   move.l #sttptr,a1
   move.l (a1),d4
   move.l d4,a3
   sub.l #sttdata,d4
.fin: tst stt				; renvoie NE si structure ou EQ si variable simple
   rts

   NON
table: bsr.s ttt
   move #145,(a2)+
   move.l a2,(a0)
   rts

   NON
string: bsr.s ttt
   bne.s .lb0
   move #143,(a2)+
   move.l (a6)+,d4
   move d4,(a2)+
   clr.b (a2)
   addq #2,d4
   bclr #0,d4
   add.w d4,a2
   move.l a2,(a0)
   rts
.lb0: move.l (a6)+,d0
   move d0,(a3)+
   clr.b (a3)
   addq #2,d0
   bclr #0,d0
   add.w d0,a3
   move.l a3,(a1)
   addq.l #2,d4
spass: lea spvar,a1
   move.l (a1)+,(a2)+
   move (a1)+,(a2)+
   move.l d4,(a2)+
   move.l (a1),(a2)+
   move.l a2,(a0)
   rts

   NON
charray: bsr ttt
   bne.s .lb2
   move #144,(a2)+
   move.l (a6)+,d4
   move.l (a6)+,d2
   move d2,d1
   addq #2,d2
   bclr #0,d2
   subq.l #1,d4
.lb1: move d1,(a2)+
   clr.b (a2)
   add.w d2,a2
   dbf d4,.lb1
   move.l a2,(a0)
   rts
.lb2: move.l (a6)+,d0
   move.l (a6)+,d1
   move.l d1,d2
   addq #2,d1
   bclr #0,d1
   subq.l #1,d0
.lb3: move d2,(a3)+
   clr.b (a3)
   add.w d1,a3
   dbf d0,.lb3
   move.l a3,(a1)
   move.l #.lb4,a1
   move.l (a1)+,(a2)+
   move (a1)+,(a2)+
   move.l d4,(a2)+
   rept 5
   move.l (a1)+,(a2)+
   endr
   move.l a2,(a0)
   rts
.lb4: move.l (a6)+,a0
   move.l (a0),a0
   dc.w $d1fc
   move (a0)+,d0
   move.l (a6),d1
   subq.l #1,d1
   addq.l #4,d0
   bclr #0,d0
   muls d0,d1
   add.l d1,a0
   move.l a0,(a6)
   rts

   NON
ouvert: bsr ttt
   move #1,setnbr
   move -2(a5),setdeb
   move #628,(a2)+
   move -2(a5),(a2)+
   move.l a2,(a0)
   rts

   NON
et: bsr ttt
   addq #1,setnbr
   move #628,(a2)+
   move -2(a5),(a2)+
   move.l a2,(a0)
   rts

   NON
ferme: bsr ttt
   move #140,(a2)+
   move setdeb,(a2)+
   move setnbr,(a2)+
   move.l a2,(a0)
   rts

   NON
setof: bsr ttt
   bne.s .lb2
   move #140,(a2)+
   move.l (a6)+,a1
   move (a1)+,(a2)+
   move (a1),d0
   move d0,(a2)+
   move d0,d1
   lsr.l #4,d0
   and #$f,d1
   bne.s .lb1
   subq #1,d0
.lb1: clr (a2)+
   dbf d0,.lb1
   move.l a2,(a0)
   rts
.lb2: move.l a4,-(sp)
   move.l (a6)+,a4
   move (a4)+,(a3)+
   move (a4),d0
   move d0,(a3)+
   move d0,d1
   move.l (sp)+,a4
   lsr.l #4,d0
   and #$f,d1
   bne.s .lb3
   subq #1,d0
.lb3: clr (a3)+
   dbf d0,.lb3
   move.l a3,(a1)
   bra spass

   NON
segment: bsr ttt
   move.l (a6)+,d1
   move.l (a6)+,d0
   tst stt
   bne.s .lb2
   move #140,(a2)+
   move d1,(a2)+
   subq #1,d1
   sub d1,d0
   move d0,(a2)+
   move d0,d1
   lsr #4,d0
   and #$f,d1
   bne.s .lb1
   subq #1,d0
.lb1: clr (a2)+
   dbf d0,.lb1
   move.l a2,(a0)
   rts
.lb2: move d1,(a3)+
   subq #1,d1
   sub d1,d0
   move d0,(a3)+
   move d0,d1
   lsr #4,d0
   and #$f,d1
   bne.s .lb3
   subq #1,d0
.lb3: clr (a3)+
   dbf d0,.lb3
   move.l a3,(a1)
   bra spass

   NON
float: bsr ttt
   bne.s .lb0
   move #140,(a2)+
   clr.l (a2)+
   clr.l (a2)+
   move.l a2,(a0)
   rts
.lb0: clr.l (a3)+
   clr.l (a3)+
   move.l a3,(a1)
   bra spass

   NON
stack: bsr ttt
   move.l (a6)+,d0
   lsl.l #2,d0
   tst stt
   bne.s .lb0
   move #141,(a2)+	; code CONSTANTE
   lea 4(a2,d0),a1	; sommet pile
   move.l a1,d0
   addq.l #3,d0
   and.b #$FC,d0
   move.l d0,a1		; align‚ sur 4
   move.l a1,(a2)		; stocke sommet comme constante
   clr.l (a1)+			; offset nul, pile vide. Sinon, offset de -4 en -4
   move.l a1,(a0)		; nouveau "here"
   rts
.lb0: add.l d0,d4
   add.l d0,a3
   clr.l (a3)+
   move.l a3,(a1)
   bra spass

   SAUT
appl_search:
	A1 18,1,1,3

   SAUT
appl_tplay:
	A1 14,2,1,1

   NON
pointer: bsr ttt
   bne.s .lb0
   move.l (a6)+,a1
   move #140,(a2)+
   clr.l (a2)+
   move.l 4(a1),(a2)+
   move.l a2,(a0)
   rts
.lb0: clr.l (a3)+
   move.l a4,-(sp)
   move.l (a6)+,a4
   move.l 4(a4),(a3)+
   move.l a3,(a1)
   move.l (sp)+,a4
   bra spass

   NON
wvar: bsr ttt
   bne.s .lb0
   move #140,(a2)+
   clr (a2)+
   move.l a2,(a0)
   rts
.lb0: clr (a3)+
   move.l a3,(a1)
   bra spass

   NON
warray: bsr ttt
   bne.s .lb2
   move #706,(a2)+
   move.l (a6)+,d1
   subq.l #1,d1
.lb1: clr (a2)+
   dbf d1,.lb1
   move.l a2,(a0)
   rts
.lb2: move.l (a6)+,d1
   subq.l #1,d1
.lb3: clr (a3)+
   dbf d1,.lb3
   move.l a3,(a1)
   move.l #.lb4,a1
   move.l (a1)+,(a2)+
   move (a1)+,(a2)+
   subq.l #2,d4
   move.l d4,(a2)+
   move.l (a1)+,(a2)+
   move.l (a1)+,(a2)+
   move (a1),(a2)+
   move.l a2,(a0)
   rts
.lb4: move.l (a6)+,a0
   move.l (a0),a0
   dc.w $d1fc
   move.l (a6),d1
   add.l d1,d1
   add.l d1,a0
   move.l a0,(a6)
   rts

   COPIE ret1,y1
ret1: move.l (a6)+,-(a4)
y1:   rts

   COPIE ret2,y2
ret2: move.l (a4)+,-(a6)
y2:   rts

   COPIE raff,y3
raff: move.l (a4),-(a6)
y3:   rts

   COPIE dup2,y4
dup2: move.l (a6),-(a6)
   bne.s y4
   addq.l #4,a6
y4: rts

   COPIE depth,y5,1
depth: move.l pilbase,d1
   sub.l a6,d1
   asr.l #2,d1
   move.l d1,-(a6)
y5:  rts

   COPIE drop,y6
drop: UP
y6:  rts

   COPIE dup,y7
dup: move.l (a6),-(a6)
y7:  rts

   COPIE over,y8
over: move.l 4(a6),-(a6)
y8:  rts

   COPIE pick,y9
pick: move.l (a6)+,d1
   if STE=0
   	move.l (a6,d1.l*4),-(a6)
   else
   	asl.l #2,d1
   	move.l 0(a6,d1.l),-(a6)
   endif
y9: rts

   COPIE rzer,y10,1
rzer: move.l #retour+4100,d1
	and.b #$fc,d1
	move.l d1,-(a6)
y10:  rts

   COPIE roll,y11
roll: move.l (a6)+,d1
   move.l (a6),d2
   move.l a6,d3
   subq #2,d1
   bmi.s y11
.lb1: move.l 4(a6),(a6)+
   dbf d1,.lb1
   move.l d2,(a6)
   move.l d3,a6
y11: rts

   COPIE rot,y12
rot: movem.l (a6)+,d1-d3
   exg.l d1,d2
   exg.l d2,d3
   movem.l d1-d3,-(a6)
y12: rts

   COPIE rpinit,y13,1
rpinit: move.l #retour+4100,d0
	and.b #$fc,d0
	move.l d0,a4
y13: rts

   COPIE wdmod,y14
wdmod: move.l (a6)+,d1
   move.l (a6),d2
   divs d1,d2
   move.l d2,d1
   ext.l d2
   move.l d2,(a6)
   swap d1
   ext.l d1
   move.l d1,-(a6)
y14: rts

   COPIE rpaff,y15
rpaff: move.l a4,-(a6)
y15:  rts

   COPIE s0,y16,1
s0: move.l pilbase,-(a6)
y16:   rts

   COPIE spinit,y17,1
spinit: move.l pilbase,a6
y17:   rts

   COPIE wmod,y18
wmod: move.l (a6)+,d1
   move.l (a6)+,d2
   divs d1,d2
   swap d2
   ext.l d2
   move.l d2,(a6)
y18: rts

   COPIE spaff,y19
spaff: move.l a6,-(a6)
y19:   rts

   COPIE swap,y20
swap: move.l (a6)+,d0
   move.l (a6),d1
   move.l d0,(a6)
   move.l d1,-(a6)
y20: rts

   COPIE mulw,y22
mulw: move.l (a6)+,d1
   muls 2(a6),d1
   move.l d1,(a6)
y22: rts

   COPIE wdiv,y23
wdiv: move.l (a6)+,d1
   move.l (a6),d2
   divs d1,d2
   ext.l d2
   move.l d2,(a6)
y23: rts

   COPIE_OPT5 plus,y24,$0696
plus: move.l (a6)+,d1
   add.l d1,(a6)
y24: rts

   COPIE plm,y25
plm: tst.l (a6)+
   bge.s y25
   neg.l (a6)
y25: rts

   COPIE_OPT5 moins,y26,$0496
moins: move.l (a6)+,d1
   sub.l d1,(a6)
y26: rts

	if STE=0

   COPIE div,y27
div: move.l (a6)+,d0
   move.l (a6)+,d1
   divsl.l d0,d2:d1      ; reste et quotient
   move.l d1,-(a6)
y27: rts

   COPIE mod,y28
mod: move.l (a6)+,d0
   move.l (a6)+,d2
   divsl.l d0,d1:d2      ; reste et quotient
   move.l d1,-(a6)
y28: rts

   COPIE divm,y29
divm: move.l (a6)+,d0
   move.l (a6)+,d2
   divsl.l d0,d1:d2
   movem.l d1-d2,-(a6)
y29: rts

   COPIE mul,y21
mul:   move.l (a6)+,d1
   muls.l (a6)+,d1
   move.l d1,-(a6)
y21: rts

	else

	SAUT
div: bsr.s spdiv
   move.l d2,(a6)
   rts

	SAUT
mod: bsr.s spdiv
   move.l d1,(a6)
   rts

	SAUT
divm: bsr.s spdiv
   move.l d2,(a6)
   move.l d1,-(a6)
   rts

spdiv: moveq.l #1,d7
   move.l d7,d6
   move.l (a6)+,d4
   bpl.s .lb1
   neg.l d4
   neg.l d7
.lb1: move.l (a6),d3
   bpl.s .lb2
   neg.l d3
   neg.l d7
   neg.l d6
.lb2: move.l #$80000000,d0
   moveq #0,d1
   moveq #0,d2
.lb3: lsl.l #1,d1
   move.l d0,d5
   and.l d3,d5
   beq.s .lb4
   addq.l #1,d1
.lb4: lsl.l #1,d2
   cmp.l d4,d1
   bmi.s .lb5
   sub.l d4,d1
   addq.l #1,d2
.lb5: lsr.l #1,d0
   bne.s .lb3
   tst.l d7
   bpl.s .lb6
   neg.l d2
.lb6: tst.l d6
   bpl.s .lb7
   neg.l d1
.lb7: rts

	SAUT
mul: clr d2
   tst.l (a6)+
   bge.s .lb1
   neg.l -4(a6)
   moveq #1,d2
.lb1: tst.l (a6)
   bge.s .lb2
   neg.l (a6)
   addq #1,d2
.lb2: move -2(a6),d0
   mulu 2(a6),d0
   move -4(a6),d1
   mulu 2(a6),d1
   move (a6),d3
   mulu -2(a6),d3
   add d3,d1
   move.l d0,(a6)
   add d1,(a6)
   btst #0,d2
   beq.s .lb3
   neg.l (a6)
.lb3: rts

	endif

   COPIE inf0,y30
inf0: moveq #0,d1
   tst.l (a6)+
   smi d1
   neg.b d1
   move.l d1,-(a6)
y30: rts

   COPIE eg0,y31
eg0: moveq #0,d1
   tst.l (a6)+
   seq d1
   neg.b d1
   move.l d1,-(a6)
y31: rts

   COPIE sup0,y32
sup0: moveq #0,d1
   tst.l (a6)+
   sgt d1
   neg.b d1
   move.l d1,-(a6)
y32: rts

   COPIE_OPT6 sup,y33
sup:
   move.l (a6)+,d1
	moveq #0,d0
   cmp.l (a6),d1
   smi d0
   neg.b d0
   move.l d0,(a6)
y33: rts

   COPIE_OPT6 inf,y34
inf:
   move.l (a6)+,d1
	moveq #0,d0
   cmp.l (a6),d1
   sgt d0
   neg.b d0
   move.l d0,(a6)
y34: rts

   COPIE_OPT6 supegal,y33b
supegal:
   move.l (a6)+,d1
	moveq #0,d0
   cmp.l (a6),d1
   sle d0
   neg.b d0
   move.l d0,(a6)
y33b: rts

   COPIE_OPT6 infegal,y34b
infegal:
   move.l (a6)+,d1
	moveq #0,d0
   cmp.l (a6),d1
   spl d0
   neg.b d0
   move.l d0,(a6)
y34b: rts

   COPIE_OPT6 egal,y35
egal:
   move.l (a6)+,d1
	moveq #0,d0
   cmp.l (a6),d1
   seq d0
   neg.b d0
   move.l d0,(a6)
;	moveq #1,d0
;	cmp.l (a6)+,(a6)+
;	dbeq d0,.lb0
;.lb0:
;	move.l d0,-(a6)
y35: rts

   COPIE plus1,y36
plus1: addq.l #1,(a6)
y36: rts

   COPIE moins1,y37
moins1: subq.l #1,(a6)
y37: rts

   COPIE plus2,y38
plus2: addq.l #2,(a6)
y38: rts

   COPIE moins2,y39
moins2: subq.l #2,(a6)
y39: rts

   COPIE mul2,y40
mul2: move.l (a6)+,d1
   asl.l #1,d1
   move.l d1,-(a6)
y40: rts

   COPIE div2,y41
div2: move.l (a6)+,d1
   asr.l #1,d1
   move.l d1,-(a6)
y41: rts

   COPIE abs,y42
abs: tst.l (a6)
   bpl.s y42
   neg.l (a6)
y42: rts

   COPIE_OPT4 and,y43,$0296
and: move.l (a6)+,d1
   and.l d1,(a6)
y43: rts

   COPIE max,y44
max: move.l (a6)+,d1
   cmp.l (a6),d1
   bmi.s y44
   move.l d1,(a6)
y44: rts

   COPIE min,y45
min: move.l (a6)+,d1
   cmp.l (a6),d1
   bpl.s y45
   move.l d1,(a6)
y45: rts

   COPIE neg,y46
neg: neg.l (a6)
y46: rts

   COPIE not,y47
not: not.l (a6)
y47: rts

   COPIE_OPT4 or,y48,$0096
or: move.l (a6)+,d1
   or.l d1,(a6)
y48: rts

   COPIE_OPT4 xor,y49,$0A96
xor: move.l (a6)+,d1
   eor.l d1,(a6)
y49: rts

   ASS 4
loop: addq.l #1,(a4)
   move.l (a4),d1
   cmp.l 4(a4),d1
   bpl.s .lb1
   move.l 8(a4),a5
   rts
.lb1: add.w #12,a4
   subq.l #4,indptr
   rts

   ASS 5
looppls: move.l (a6)+,d1
   ble.s .lb2
   add.l d1,(a4)
   move.l (a4),d1
   cmp.l 4(a4),d1
   bmi.s .lb1
.lb0: add.w #12,a4
   subq.l #4,indptr
   rts
.lb1: move.l 8(a4),a5
   rts
.lb2: add.l d1,(a4)
   move.l (a4),d1
   cmp.l 4(a4),d1
   bpl.s .lb1
   bra.s .lb0

   ASS 6
do:
	movem.l (a6)+,d0-d1		; start et fin
	cmp.l d0,d1
	bne.s .lb0					; boucle normale
	add.w (a5),a5				; boucle vide, saute sur le loop
	cmp.w #156,(a5)+			; est-ce un "ifloop"
	bne.s .lb1
	subq.l #4,a6				; si oui, laisse l'indice en sortie !
.lb1:
	rts
.lb0:
	addq.l #2,a5				; saute l'offset
	movem.l d0-d1/a5,-(a4)
   lea indptr,a1
   addq.l #4,(a1)
   move.l (a1),a2
   move.l a4,(a2)
   rts

   ASS 8
again: move.l (a4),a5
   rts

   ASS 7
begin: move.l a5,-(a4)
   rts

   ASS 9
until: tst.l (a6)+
   bne.s .lb1
   move.l (a4),a5
   rts
.lb1: addq.l #4,a4
   rts

   ASS 25
of: move.l (a6)+,d1
   cmp.l (a6),d1
   beq.s .lb1
   add.w (a5)+,a5
   rts
.lb1: addq.l #2,a5
   UP
   rts

   ASS 33
difof: move.l (a6)+,d1
   cmp.l (a6),d1
   bne.s .lb1
   add.w (a5)+,a5
   rts
.lb1: addq.l #2,a5
   UP
   rts

   ASS 34
supof: move.l (a6)+,d1
   cmp.l (a6),d1
   bmi.s .lb1
   add.w (a5)+,a5
   rts
.lb1: addq.l #2,a5
   UP
   rts

   ASS 35
infof: move.l (a6)+,d1
   cmp.l (a6),d1
   bgt.s .lb1
   add.w (a5)+,a5
   rts
.lb1:  addq.l #2,a5
   UP
   rts

   ASS 13
if: tst.l (a6)+
   bne.s .lb1
   add.w (a5)+,a5
   rts
.lb1: addq.l #2,a5
   rts

   ASS 10
while: tst.l (a6)+
   bne.s .lb1
   add.w (a5)+,a5
   addq.l #4,a4
   rts
.lb1: addq.l #2,a5
   rts

   ASS 11
repeat: move.l (a4),a5
   rts

   ASS 14
else: add.w (a5)+,a5
   rts

   ASS 15
then: rts

   ASS 24
endcase: rts

   ASS 23
case: rts

   SAUT
appl_find:
	A1 13,0,1,1

   COPIE i,y50,1
i: move.l indptr,a1
	if STE=0
	   move.l ([a1]),-(a6)
	else
		move.l (a1),a1
		move.l (a1),-(a6)
	endif
y50: rts

   COPIE j,y51,1
j: move.l indptr,a1
	if STE=0
	   move.l ([-4.w,a1]),-(a6)
	else
		move.l -4(a1),a1
		move.l (a1),-(a6)
	endif
y51: rts

   COPIE k,y52,1
k: move.l indptr,a1
	if STE=0
	   move.l ([-8.w,a1]),-(a6)
	else
		move.l -8(a1),a1
		move.l (a1),-(a6)
	endif
y52: rts

   COPIE leave,y53,1
leave:
	if STE=0
		move.l ([indptr]),a0
	else
		move.l indptr,a0
		move.l (a0),a0
	endif
	move.l 4(a0),(a0)
y53: rts

   COPIE virg,y54,1
virg: move.l topprg,a0
   move.l (a6)+,(a0)+
   move.l a0,topprg
y54: rts

   ASS 12
exit:
	move.l #retour+4100,d1
	and.b #$fc,d1
	cmp.l a4,d1
	beq.s .lb0
	move.l (a4)+,a5
.lb0:
   rts

   ASS -1
pvirg: move.l (a4)+,a5
   rts

   COPIE allot,y55,1
allot: move.l (a6)+,d1
   addq.l #1,d1
   bclr #0,d1
   move.l topprg,-(a6)
   add.l d1,topprg
y55: rts

   SAUT
allot0: move.l (a6),d1
   addq.l #1,d1
   bclr #0,d1
   move.l topprg,a2
   add.l d1,topprg
   move.l a2,(a6)
   move d1,d0
   and #$3f,d0
   lsr.l #6,d1
   subq #1,d1
   bmi.s .lb1
.lb0:
   rept 16
   clr.l (a2)+
   endr
   dbf d1,.lb0
.lb1: subq #1,d0
   bmi.s .lb3
.lb2: clr.b (a2)+
   dbf d0,.lb2
.lb3: rts

   SAUT
chsto: move.l (a6)+,a3
   move.l (a6)+,a2
   move -2(a2),d1
   move -2(a3),d2
   move d1,d3
   cmp d1,d2
   bgt.s .lb1
   move d2,d3
   bra.s .lb1
.lb2: move.b (a2)+,(a3)+
.lb1: dbeq d3,.lb2
;   beq.s .lb3
;   cmp.l d1,d2
;   ble.s .lb3
   clr.b (a3)
.lb3: rts

   SAUT
chplus: move.l (a6)+,a1
   move.l (a6)+,a2
   move -2(a1),d1
   move -2(a2),d2
   bra.s .lb0
.lb1: tst.b (a1)+
.lb0: dbeq d1,.lb1
   bne.s .fin
   subq.l #1,a1
   addq #1,d1
   subq #1,d2
   cmp d2,d1
   bpl.s .lb2
   move d1,d2
.lb2: move.b (a2)+,(a1)+
   dbeq d2,.lb2
.fin: rts

   SAUT
chegal: bsr.s strcomp
   bne.s .lb1
   moveq #1,d0
.lb1: move.l d0,(a6)
   rts

   SAUT
chsup: bsr.s strcomp
   bpl.s .lb1
   moveq #1,d0
.lb1: move.l d0,(a6)
   rts

   SAUT
chinf: bsr.s strcomp
   ble.s .lb1
   moveq #1,d0
.lb1: move.l d0,(a6)
   rts

strcomp: move.l (a6)+,a0
   move.l (a6),a1
.lb1: move.b (a0)+,d1
   sub.b (a1),d1
   bne.s .lb2
   tst.b (a1)+
   bne.s .lb1
.lb2: moveq #0,d0
   tst.b d1
   rts

   COPIE asc,y56
carrcl:
asc: moveq #0,d1
	if STE=0
	   move.b ([a6]),d1
	else
		move.l (a6),a0
		move.b (a0),d1
	endif
   move.l d1,(a6)
y56: rts

   COPIE bbase,y57,1
bbase: move.l #base,-(a6)
y57: rts

   COPIE chr,y58,1
chr: move.l (a6)+,d1
   move.l #pad+2,a0
   move.l a0,-(a6)
   lsl #8,d1
   move d1,(a0)
y58: rts

   COPIE decimal,y59,1
decimal: moveq #10,d1
   move.l d1,base
y59: rts

   COPIE hex,y60,1
hex: moveq #16,d1
   move.l d1,base
y60: rts

   SAUT
instr: move.l (a6)+,d0
   move.l d0,d4
   move.l (a6)+,a2
   moveq #-2,d2
.lb1: addq #1,d2
   tst.b (a2)+
   bne.s .lb1
   tst d2
   bpl.s  .lb11
   move.l d0,(a6)
   rts
.lb11: move.l -4(a6),a2
   move.l (a6),a1
   moveq #-2,d1
.lb2: addq #1,d1
   tst.b (a1)+
   bne.s .lb2
   move.l (a6),a1
   clr.l (a6)
   subq #1,d0
   sub.w d0,d1
   add.w d0,a1
   sub.w d2,d1
   bpl.s .lb3
   rts
.lb3: move d2,d3
   move.l a2,a0
   move.l a1,a3
.lb4: cmp.b (a3)+,(a0)+
   dbne d3,.lb4
   beq.s .lb5
   addq #1,d4
   addq.l #1,a1
   dbf d1,.lb3
   rts
.lb5: move.l d4,(a6)
   rts

   COPIE len,y61
len: move.l (a6)+,a3
   move.l a3,d0
.lb1: tst.b (a3)+
   bne.s .lb1
   sub.l d0,a3
   subq.l #1,a3
   move.l a3,-(a6)
y61: rts

   COPIE left,y62,1
left: move.l (a6)+,d1
   move.l (a6),a1
   move.l #pad,a2
   move (a2)+,d2
   move.l a2,(a6)
   move -2(a1),d3
   cmp d1,d2
   bpl.s .lb1
   move d2,d1
.lb1: cmp d1,d3
   bgt.s .lb4
   move d3,d1
	bra.s .lb4
.lb3: move.b (a1)+,(a2)+
.lb4: dbeq d1,.lb3
   clr.b (a2)
y62: rts

   SAUT
mid: move.l #pad+2,a1
   move.l (a6)+,d1
   move.l (a6)+,d2
   move.l (a6),a0
   move.l a1,(a6)
   subq #1,d1
   bmi.s .fin
   subq #2,d2
   bmi.s .lb2
.lb1: tst.b (a0)+
   dbeq d2,.lb1
   beq.s .fin
.lb2: move.b (a0)+,(a1)+
   dbeq d1,.lb2
.fin: clr.b (a1)
   rts

   COPIE mlen,y63
mlen: if STE=0
		move.w ([a6],-2.w),2(a6)
	else
		move.l (a6),a0
		move -2(a0),2(a6)
	endif
	clr (a6)
y63: rts

   COPIE ppad,y64,1
ppad: move.l #pad+2,-(a6)
y64: rts

   SAUT
right: move.l (a6)+,d1
   move.l (a6),a0
   move.l #pad+2,a1
   tst.l d1
   bgt.s .lb1
   move.l a1,(a6)
   clr.b (a1)
   rts
.lb1: tst.b (a0)+
   bne.s .lb1
   subq.l #1,a0
   sub.w d1,a0
   cmp.l (a6),a0
   bpl.s .lb2
   move.l (a6),a0
.lb2: move.l a1,(a6)
.lb3: move.b (a0)+,(a1)+
   bne.s .lb3
   rts

   COPIE str,y65,1
str: st ecran
   jsr point
   move.l #pad+2,a2
   move.l a2,-(a6)
   sf ecran
.lb1: move.b (a1)+,(a2)+
   bne.s .lb1
y65: rts

   ASS 29
xplus: move.l (a6)+,d0
   add.l (a6)+,d0
   bra.s xcut1

   ASS 30
xcut: move.l (a6)+,d0
xcut1: move d0,d1
   asl #2,d1
   lea adresse,a1
   move.l 0(a1,d1.w),a1
   cmp #diko,d0
   bpl.s .lb1
   jmp (a1)
.lb1: move.l a5,-(a4)
   move.l a1,a5
   rts

   SAUT
val: move.l (a6),a0	; chaine
   move -2(a0),d4		; taille max
   clr d7
   clr.l (a6)
   move.l base,-(sp)
   move.b (a0),d0
   cmp.b #"%",d0
   bne.s .lba
   move.l (a7),d1
   addq.l #1,a0
   move.b (a0)+,d0
   cmp.b #"d",d0
   bne.s .lbb
   moveq #10,d1
   bra.s .lbc
.lbb: cmp.b #"h",d0
   bne.s .lbd
   moveq #16,d1
   bra.s .lbc
.lbd: cmp.b #"b",d0
   bne.s .lbe
   moveq #2,d1
   bra.s .lbc
.lbe: cmp.b #"o",d0
   bne.s .lbc
   moveq #8,d1
.lbc: move.l d1,base
   move.b (a0),d0
.lba: cmp.b #"-",d0
   bne.s .lb1
   move #1,d7
.lb0: addq.l #1,a0
   subq #1,d4
   bra.s .lb2
.lb1: cmp.b #"+",d0
   beq.s .lb0
.lb2: move.b (a0)+,d5
   beq.s .fin
   sub.b #"0",d5
   bmi.s .fin
   cmp.b #10,d5
   bmi.s .lb4
   subq.b #7,d5
   cmp.b #36,d5
   bmi.s .lb4
   sub.b #32,d5
.lb4: ext.w d5
   ext.l d5
   cmp.l base,d5
   bpl.s .fin
   subq #1,d4
   bmi.s .fin
	if STE=0
	   move.l base,d0
   	muls.l (a6),d0
   	move.l d0,(a6)
   else
   	move.l base,-(a6)
   	bsr mul
	endif
   add.l d5,(a6)
   bra.s .lb2
.fin: tst d7
   beq.s .lb5
   neg.l (a6)
.lb5: move.l (sp)+,base
   rts

   COPIE sto,y66
sto: move.l (a6)+,a2
   move.l (a6)+,(a2)
y66: rts

	COPIE isto,y666
isto:
	move.l (a6)+,a2
	move.l (a6)+,d0
	ror #8,d0
	swap d0
	ror #8,d0
	move.l d0,(a2)
y666:	rts

   COPIE stop,y67
stop: move.l (a6)+,a2
   move.l (a6)+,d1
   add.l d1,(a2)
y67: rts

   COPIE stom,y68
stom: move.l (a6)+,a2
   move.l (a6)+,d1
   sub.l d1,(a2)
y68: rts

   COPIE stop1,y69
stop1: move.l (a6)+,a2
   addq.l #1,(a2)
y69: rts

   COPIE stom1,y70
stom1: move.l (a6)+,a2
   subq.l #1,(a2)
y70: rts

	SAUT
ircl:
	if STE=0
		move.l ([a6]),d0
	else
		move.l (a6),a0
		move.l (a0),d0
	endif
	ror #8,d0
	swap d0
	ror #8,d0
	move.l d0,(a6)
	rts

   COPIE rcl,y71
rcl: if STE=0
		move.l ([a6]),(a6)
	else
		move.l (a6),a0
		move.l (a0),(a6)
	endif
y71: rts

   COPIE carsto,y72
carsto: move.l (a6)+,a2
   move.l (a6)+,d1
   move.b d1,(a2)
y72: rts

   SAUT
cls:
	tst screen_percent	; si <>0
	bne.s .prg				; sortie VDI en fenetre
	pea .vide(pc)
	GEMDOS 9,6
	rts
.vide: dc.b 27,"E",0
	even
.prg:
   lea copy_pts,a0
  	move.l fenetre,a1
  	clr.l 8(a1)				; curseur en haut … droite
   move.l (a1)+,d0
   move.l d0,(a0)+     ; x et y
   add.l (a1),d0
   sub.l #$10001,d0     ; x' et y' ( ‚gaux … x,y + l,h -1,1 )
   move.l d0,(a0)
   GEM_VDI fill_rect
   rts

   COPIE bin,y74,1
bin: moveq #2,d1
   move.l d1,base
y74:  rts

   COPIE here,y75,1
here: move.l topprg,-(a6)
y75: rts

   COPIE dupm,y76
dupm: move.l (a6)+,d1
	if STE=0
   	lea (a6,d1.w*4),a2
   else
   	lea 0(a6,d1.w),a2
   	add d1,a2
   	add d1,a2
   	add d1,a2
   endif
   bra.s .lb2
.lb1: move.l -(a2),-(a6)
.lb2: dbf d1,.lb1
y76: rts

   COPIE dropm,y77
dropm: move.l (a6)+,d1
	if STE=0
	   lea (a6,d1.l*4),a6
	else
		asl.l #2,d1
		lea 0(a6,d1.l),a6
	endif
y77: rts

	SAUT
uhpt:
	move.l (a6)+,d1
	move.l #tamp+40,a0
	clr.b -(a0)
	move sizeptr,d0
	cmp #3,d0			; r‚gl‚ sur float?
	seq d3				; flag pour recommencer
	bne.s .lb1
	moveq #2,d0			; si oui, revenir … LONG
	move.l d1,d5		; … traiter ensuite
	move.l (a6)+,d1
.lb1:
	addq #1,d0			; 1,2,3 pour b,w,l
	moveq #1,d2
	lsl d0,d2			; 2,4,8 pour b,w,l
	subq #1,d2			; 1,3,7 nombre de caractŠres … sortir
	move d2,d4			; en cas de seconde boucle
.lb0:
	move.b d1,d0
	and.b #$F,d0
	add.b #'0',d0
	cmp.b #'9'+1,d0
	bmi.s .ok
	add.b #'A'-'9'-1,d0
.ok:
	move.b d0,-(a0)
	lsr.l #4,d1
	dbf d2,.lb0
	tst.b d3
	beq.s .out
	sf d3
	move d4,d2
	move.l d5,d1
	bra.s .lb0
.out:
	bsr write_str
	rts

	SAUT
ubpt:
	move.l (a6)+,d1
	move.l #tamp+40,a0
	clr.b -(a0)
	move sizeptr,d0
	cmp #3,d0			; r‚gl‚ sur float?
	bne.s .lb2
	moveq #2,d0			; si oui, revenir … LONG
.lb2:
	addq #1,d0			; 1,2,3 pour b,w,l
	moveq #4,d2
	lsl d0,d2			; 8,16,32 pour b,w,l
	subq #1,d2			; 7,15,31 nombre de caractŠres … sortir
.lb0:
	moveq #'0',d0
	lsr.l #1,d1
	bcc.s .lb1
	addq.b #1,d0
.lb1:
	move.b d0,-(a0)
	dbf d2,.lb0
	bsr write_str
	rts

   SAUT
bpt: moveq #2,d4
   bra.s pt

   SAUT
dpt: moveq #10,d4
   bra.s pt

   SAUT
opt: moveq #8,d4
   bra.s pt

   SAUT
hpt: moveq #16,d4
   bra.s pt

   SAUT
aff: move.l (a6),a2
   move.l (a2),(a6)
   bra.s point

   SAUT
point: move.l base,d4
pt: move.l (a6)+,d3
   moveq #0,d6
   tst.l d3
   bpl.s .lb1
   neg.l d3
   move.b #$2d,d6
.lb1: move.l #tamp+40,a1
   clr.b -(a1)
.lb2: move.l #$80000000,d0
   moveq #0,d1
   moveq #0,d2
.lb3: lsl.l #1,d1
   move.l d0,d5
   and.l d3,d5
   beq.s .lb4
   addq.l #1,d1
.lb4: lsl.l #1,d2
   cmp.l d4,d1
   bmi.s .lb5
   sub.l d4,d1
   addq.l #1,d2
.lb5: lsr.l #1,d0
   bne.s .lb3
   add.b #48,d1
   cmp #$3a,d1
   bmi.s .lb6
   addq.b #7,d1
.lb6: move.b d1,-(a1)
   move.l d2,d3
   bne.s .lb2
   tst d6
   beq.s .lb7
   move.b d6,-(a1)
.lb7: tst.b ecran
   bne.s .lb8
   move.l a1,a0
   bsr write_str
.lb8: rts

   COPIE term,y78
term: move #2,-(sp)
	BIOS 1,4
   move.l d0,-(a6)
y78: rts

   COPIE bl,y79
bl: moveq #32,d1
   move.l d1,-(a6)
y79: rts

   SAUT
cr:
	tst screen_percent	; si <>0
	bne.s .prg				; sortie VDI en fenetre
	pea .saut(pc)
	GEMDOS 9,6
	rts
.saut: dc.b 13,10,0
	even
.prg:
	if STE=0
		lea ([fenetre,pc],8.w),a0
   	lea ([fenetre,pc]),a1
   else
   	move.l fenetre,a1
   	lea 8(a1),a0
   endif
   clr (a0)+          ; x=0, 1ø colonne
   move (a0),d0      ; y
   add 4(a0),d0      ; plus une colonne
   move 6(a1),d1     ; H
   sub 4(a0),d1      ; moins la hauteur de la ligne
   cmp d0,d1
   bmi.s .lb0        ; il faut scroller
   move d0,(a0)      ; sinon, colonne valable
   rts
.lb0:
	move 4(a0),d7     ; hauteur d'un caractŠre
	ext.l d7
	move (a0),d6      ; y du curseur
	ext.l d6
	lea copy_pts,a0
	move.l (a1)+,d5
	move.l d5,(a0)
	add.l d7,(a0)+
	sub.l #$10001,d5  ; pour l'angle oppos‚
	move.l (a1),(a0)
	add.l d5,(a0)+
	move.l -(a1),(a0)+
	move.l -8(a0),(a0)
	sub.l d7,(a0)
	move #3,copy_int
	clr.l mf1
	clr.l mf2
	GEM_VDI hide_mouse
	GEM_VDI copy_tab
	lea copy_pts,a0
	move.l fenetre,a1
	add.l (a1)+,d6
	move.l d6,(a0)+
	add.l (a1),d5
	move.l d5,(a0)
	GEM_VDI fill_rect
	GEM_VDI show_mouse
   rts

   SAUT
emit: addq.l #2,a6
   move.l a6,a0
   move (a6),d0
   lsl #8,d0
   move d0,(a6)
   bsr write_str
   addq.l #2,a6
   rts

   SAUT
expect: move.l (a6)+,a0   ; chaine
   move -2(a0),d6        ; taille maxi
   ext.l d6
   move.l user_list,end_keys
   bsr edition
   rts

   COPIE inkey,y82
inkey: move #$ff,-(sp)
   GEMDOS 6,4
   move.l d0,-(a6)
y82: rts

   SAUT
input: bsr.s inputc
   bra val

   SAUT
inputc: lea pad,a0
   move (a0)+,d6    ; chaine pad+2, et taille maxi dans d6
   ext.l d6
   clr.b (a0)       ; vide la chaine
   move.l a0,-(a6)  ; pad sur la pile
   move.l user_list,end_keys
   bsr edition
   rts

user_list: dc.l user_keys
user_keys: dc.w 0,$1c0d,$720d,0

   SAUT
key:
	moveq #0,d3
	ifd LIB					; pour forth.lib
		tst.b aes_flag
		bne.s .touche0
		.touche1:
			move #255,-(sp)
			GEMDOS 6,4		; touche?
			move.l d0,d1
			beq.s .touche1
		swap d1
		lsl.w #8,d1			; code clavier dans octet fort
		or d1,d0				; clavier+ASCII
		move d0,d3
	   bra.s .touche2
	   .touche0:
	endif
   GEM_AES event_key
   move i_intout,d3   ; caractŠre+code
.touche2:
   move.l d3,-(a6)
   rts

   SAUT
spc: move #$2000,-(a6)
   move.l a6,a0
   bsr write_str
   addq.l #2,a6
   rts

   SAUT
spcs: move.l (a6)+,d5
   move #$2000,-(a6)
   bra.s .lb2
.lb1: move.l a6,a0
   bsr write_str
.lb2: dbf d5,.lb1
   addq.l #2,a6
   rts

   SAUT
type: move.l (a6)+,a0
   bsr write_str
   rts

	dc.l write_str			; cas d'assemblage, besoin de cette r‚f‚rence.
   ASS 19
disply: move (a5)+,d0	; taille … sauter
	move.l a5,a0         ; chaine
	add.w d0,a5          ; saute la chaine
	bsr write_str
   rts

   ASS 20
chain: move (a5)+,d1		; taille
   move.l a5,-(a6)      ; d‚pose l'adresse de la chaine
   add.w d1,a5          ; instruction suivante
   rts

	; routine lors d'un assemblage
thvar:
	move.l (a6)+,a1
	move.l thptr,d1		; est-ce z‚ro?
	beq.s .lb0				; oui, rien … faire, l'adresse est d‚j… la bonne
	move.l d1,a0			; sinon, adresse thread
	move.l 4(a0),d1		; l'ID
.lb0:
	muls (a1)+,d1			; ID*taille donn‚es
	add.l d1,a1				; ajoute offset
	move.l a1,-(a6)
	rts

	NON
thv1:
	move.l thptr,d1
	beq.s .lb0				; pas de thread, indice z‚ro
	move.l d1,a0
	move.l 4(a0),d1		; ID du thread
.lb0:
	muls (a5)+,d1			; *taille = offset
	add.l d1,a5
	bra.s var1				; termine comme une variable

   NON
var1: move.l a5,-(a6)
   move.l (a4)+,a5
   rts

   NON
cons1: move.l (a5),-(a6)
   move.l (a4)+,a5
   rts

   NON
arr1: move.l (a6)+,d1
_arrcom:
	if STE=0
	   lea (a5,d1.l*4),a5
	else
		asl.l #2,d1
		lea 0(a5,d1.l),a5
	endif
   move.l a5,-(a6)
   move.l (a4)+,a5
   rts

   NON
war: move.l (a6),d1
	if STE=0
	   lea (a5,d1.l*2),a5
	else
		add.l d1,d1
		lea 0(a5,d1.l),a5
	endif
   move.l a5,(a6)
   move.l (a4)+,a5
   rts

   NON
str1: addq.l #2,a5
   move.l a5,-(a6)
   move.l (a4)+,a5
   rts

   NON
char1: move.l (a6),d1
   move (a5)+,d2
   addq #4,d2
   bclr #0,d2
   mulu d2,d1
   add.l a5,d1
   move.l d1,(a6)
   move.l (a4)+,a5
   rts

   NON
tab1: move.l (a6),d1
   if STE=0
	   move.l (a5,d1.l*4),(a6)
	else
		asl.l #2,d1
		move.l 0(a5,d1.l),(a6)
	endif
   move.l (a4)+,a5
   rts

   COPIE timer,y86
timer: clr.l -(sp)
   GEMDOS 32,6
   move.l $4ba.w,-(a6)
   move.l d0,-(sp)
   GEMDOS 32,6
y86: rts

   COPIE_OPT6 dif,y87
dif:
   move.l (a6)+,d1
	moveq #0,d0
   cmp.l (a6),d1
   sne d0
   neg.b d0
   move.l d0,(a6)
y87: rts

   COPIE free,y88,1
free: move.l botmem,d1
   sub.l topprg,d1
   move.l d1,-(a6)
y88: rts

   COPIE full,y89,1
full: move.l topprg,d1
   sub.l program,d1
   add.l topmem,d1
   sub.l botmem,d1
   move.l d1,-(a6)
y89: rts

standard: dc.b $FF			; valide pour fonctionnement conforme au standard (d‚faut et S dans FORTH.INI)
									; 00 pour mes routines diff‚rentes ( s dans FORTH.INI)
	even

   SAUT
pilaf: movem.l a4-a6,regist
   move.l pilbase,d7
   sub.l a6,d7
   bpl.s .lb0
   move.l #'*',-(a6)
   bra emit
.lb0:
	tst.b standard
	beq.s .lb1
.lb22:						; ici affiche du bas vers le sommet
	subq.l #4,d7
	bmi.s .lb4
	move.l 0(a6,d7.l),-(a6)
	bsr point
	bsr spc
	bra.s .lb22
.lb4:	bsr.s .top
	bra.s .lb3
.top: lea .top_txt(pc),a0
	bsr write_str
	rts
.lb1: asr.l #2,d7
.lb2: bsr.s .top		; affiche (top)
.lb23:
	subq.l #1,d7		; ici affiche du sommet vers la bas
   bmi.s .lb3
   bsr point
   move -2(a6),d6
   bsr spc
   move d6,-2(a6)
   bra.s .lb23
.lb3: movem.l regist,a4-a6
   rts
.top_txt: dc.b "(top) ",0
	even

   NON
doesa: move #1,ass
   bra.s does

   NON
does: move.l topprg,a2
   move.l (a4),a0				; adresse mot suivant
   move (a0)+,d1				; code du mot cr‚‚
   move.l a0,(a4)				; et on le saute
   ext.l d1
   asl.l #2,d1
   lea adresse,a1
   move.l a2,0(a1,d1)		; le mot cr‚‚ pointe dansle dicco
   movem.l a4/a6,doesreg
   move.l a5,a0
   tst ass
   beq.s .lba
   move #437,(a2)+			; si assembl‚, met le code [ass]
.lba: move.l (a6)+,d0		; nombre de paramŠtres
	beq.s .lb2					; z‚ro, c'est fini
	move.l d0,d1
	lsl.l #2,d1
	add.l d1,a6					; pile ajust‚e
   movem.l a4/a6,doesreg	; et met … jour
   subq.l #1,d0				; pour la boucle
   tst ass
   beq.s .lb0
.lb0a:
	moveq #0,d4					; code [empile]
	move.l -(a6),d5			; valeur
   if STE=1
	   jsr assemblons
	else
		bsr.l assemblons
	endif
	dbf d0,.lb0a
   bra.s .lb2
.lb0:
	clr (a2)+					; code [empile]
	move.l -(a6),(a2)+		; et la valeur
	dbf d0,.lb0
.lb2: move (a0)+,d4
   bne.s .lb5
   tst ass
   beq.s .lb1
   move.l (a0)+,d5
   if STE=1
	   jsr assemblons
	else
		bsr.l assemblons
	endif
   bra.s .lb2
.lb1: clr (a2)+            ; empl
   move.l (a0)+,(a2)+
   bra.s .lb2
.lb5: cmp #637,d4       ; empl float
   bne.s .lb55
   tst ass
   beq.s .lb4
   move #$2d3c,(a2)+
   move.l (a0)+,(a2)+
   move #$2d3c,(a2)+
   move.l (a0)+,(a2)+
   bra.s .lb2
.lb4: move d4,(a2)+
   move.l (a0)+,(a2)+
   move.l (a0)+,(a2)+
   bra.s .lb2
.lb55: cmp #154,d4      ; ;end
   beq.s .lb3
   bsr.s .lb9
   tst ass
   beq.s .lb6
   if STE=1
	   jsr assemblons
	else
		bsr.l assemblons
	endif
   bra.s .lb2
.lb6: move d4,(a2)+        ; autre
   tst d0
   bmi.s .lb2
   move d0,(a2)+
   bra.s .lb2
.lb3: tst ass
   beq.s .lb7
   move #$4e75,(a2)+
   bra.s .lb8
.lb7: move #79,(a2)+
.lb8: move.l a2,topprg
   movem.l doesreg,a4/a6
   move.l a0,a5
   clr ass
   rts
.lb9: moveq #-1,d0
   cmp #66,d4
   beq.s .lb10
   cmp #700,d4
   beq.s .lb10
   cmp #701,d4
   beq.s .lb10
   cmp #702,d4
   beq.s .lb10
   cmp #712,d4
   beq.s .lb10
   cmp #714,d4
   beq.s .lb10
   cmp #69,d4
   beq.s .lb10
   cmp #62,d4
   beq.s .lb10
   cmp #70,d4
   beq.s .lb10
   cmp #67,d4
   beq.s .lb10
   rts
.lb10: move (a0)+,d0
   rts

   ASS 16
ifloop: tst.l (a6)+
   beq.s .lb1
   addq.l #1,(a4)
   move.l (a4),d1
   cmp.l 4(a4),d1
   bpl.s .lb1
   move.l 8(a4),a5
   rts
.lb1: move.l (a4),-(a6)
   add.w #12,a4
   subq.l #4,indptr
   rts

   COPIE stform,y90,1
stform: move.l #form+79,formptr
   move.l formptr,a1
   clr.b (a1)
y90: rts

	if STE=0
	   	SAUT
		diese: move.l (a6),d2
			beq.s .nul_char
	   	divsl.l base,d1:d2
	   	move.l d2,(a6)
   else
	   	SAUT
   	diese: tst.l (a6)
   		beq.s .nul_char
   		move.l base,-(a6)
   		bsr spdiv
   		move.l d2,(a6)
   endif
   tst.l d1
   bpl.s .lb1
   neg.l d1
.lb1: cmp.b #10,d1
   bmi.s .lb2
   addq #7,d1
.lb2: add #48,d1
.lb3:
   move.l formptr,a1
   move.b d1,-(a1)
   move.l a1,formptr
   rts
.nul_char:
	move.l nul_ch,d1
	bra.s .lb3

   COPIE hold,y92,1
hold: subq.l #1,formptr
   move.l formptr,a1
   addq.l #3,a6
   move.b (a6)+,(a1)
y92: rts

   SAUT
dieses: st ecran
   bsr point
   sf ecran
   moveq #-2,d1
.lb1: addq #1,d1
   tst.b (a1)+
   bne.s .lb1
   subq.l #1,a1
   move.l formptr,a2
.lb2: move.b -(a1),-(a2)
   dbf d1,.lb2
   move.l a2,formptr
   moveq #0,d0
   move.l d0,-(a6)
   rts

   COPIE edform,y93,1
edform: move.l formptr,a1
   move.l #pad+2,a2
   move.l a2,(a6)
.lb1: move.b (a1)+,(a2)+
   bne.s .lb1
y93: rts

   SAUT
call: move.l (a6)+,a0
   jmp (a0)

   COPIE top,y94,1
top: move.l #topprg,-(a6)
y94: rts

   COPIE wrcl,y95
wrcl: moveq #0,d1
   if STE=0
   	move.w ([a6]),d1
   	move.l d1,(a6)
   else
   	move.l (a6)+,a0
   	move.w (a0),d1
   	move.l d1,-(a6)
   endif
y95: rts

   COPIE wsto,y96
wsto: move.l (a6)+,a3
   addq.l #2,a6
   move (a6)+,(a3)
y96:  rts


   COPIE iwrcl,y95a
iwrcl: moveq #0,d1
   if STE=0
   	move.w ([a6]),d1
      ror #8,d1
      move.l d1,(a6)
   else
   	move.l (a6)+,a0
   	move.w (a0),d1
      ror #8,d1
      move.l d1,-(a6)
   endif
y95a: rts

   COPIE iwsto,y96a
iwsto: move.l (a6)+,a3
   addq.l #2,a6
   move (a6)+,d1
   ror #8,d1
   move d1,(a3)
y96a:  rts

   SAUT
seizeb: move.l (a6)+,a1
   move.l (a6),a2
   move.l a2,d0
   moveq #0,d2
.lb1: move.b (a2)+,d2
   beq.s .lb2
   move d2,(a1)+
   bra.s .lb1
.lb2: sub.l d0,a2
   subq.l #1,a2
   move.l a2,(a6)
	rts

   COPIE gmds,y97,1
gmds: move.l (a6)+,d1
   move.l topprg,a3
   move.l -(a3),d0
   move.l a7,d5
.lb1: move -(a3),-(a7)
   cmp.l a3,d1
   bmi.s .lb1
   move.l d1,topprg
   trap #1
   move.l d5,a7
   move.l d0,-(a6)
y97: rts

   COPIE bioss,y98,1
bioss: move.l (a6)+,d1	; valeur here sauvegard‚e
   move.l topprg,a3
   move.l -(a3),d0		; valeur d0
   move.l a7,d5
.lb1: move -(a3),-(a7)	; copie mots
   cmp.l a3,d1				; jusqu'… here
   bmi.s .lb1
   move.l d1,topprg		; et restaure le dicco
   trap #13
   move.l d5,a7
   move.l d0,-(a6)
y98: rts

   COPIE xbioss,y99,1
xbioss: move.l (a6)+,d1
   move.l topprg,a3
   move.l -(a3),d0
   move.l a7,d5
.lb1: move -(a3),-(a7)
   cmp.l a3,d1
   bmi.s .lb1
   move.l d1,topprg
   trap #14
   move.l d5,a7
   move.l d0,-(a6)
y99: rts

   COPIE wvirg,y100,1
wvirg: move.l topprg,a0
   addq.l #2,a6
   move (a6)+,(a0)+
   move.l a0,topprg
y100: rts

   COPIE ebw,y101
ebw: move.l (a6)+,d1
   ext.w d1
   move.l d1,-(a6)
y101: rts

   COPIE ebl,y102
ebl: move.l (a6)+,d1
	if STE=0
	   extb.l d1
	else
		ext.w d1
		ext.l d1
	endif
   move.l d1,-(a6)
y102: rts

   COPIE ewl,y103
ewl: move.l (a6)+,d1
   ext.l d1
   move.l d1,-(a6)
y103: rts

   COPIE puts,y104
puts: move.l (a6)+,a2
   move.l (a6)+,a3
.lb1: move.b (a3)+,(a2)+
   bne.s .lb1
y104: rts

   COPIE gets,y105
gets: move.l (a6)+,a2
   move.l (a6)+,a3
   move -2(a2),d1
.lb1: move.b (a3)+,(a2)+
   dbeq d1,.lb1
   clr.b -(a2)
y105: rts

   COPIE fcr,y106
fcr: addq.l #2,a6
   move (a6)+,-(sp)
   move.l (a6)+,-(sp)
   GEMDOS 60,8
   move.l d0,-(a6)
y106: rts

   COPIE ffs,y108
ffs: move.l (a6)+,d1
   move d1,-(sp)
   move.l (a6)+,-(sp)
   GEMDOS 78,8
   move.l d0,-(a6)
y108: rts

   COPIE fcl,y109
fcl: move 2(a6),-(sp)
   GEMDOS 62,4
   move.l d0,(a6)
y109: rts

   COPIE frd,y110
frd: move.l (a6)+,-(sp)
   move.l (a6)+,-(sp)
   move.l (a6)+,d1
   move d1,-(sp)
   GEMDOS 63,12
   move.l d0,-(a6)
y110: rts

   COPIE fwr,y111
fwr: move.l (a6)+,-(sp)
   move.l (a6)+,-(sp)
   move.l (a6)+,d1
   move d1,-(sp)
   GEMDOS 64,12
   move.l d0,-(a6)
y111: rts

   COPIE fgd,y112
fgd: GEMDOS 47,2
   move.l d0,-(a6)
y112: rts

   COPIE fdl,y113
fdl: move.l (a6)+,-(sp)
   GEMDOS 65,6
   move.l d0,-(a6)
y113: rts

   COPIE fnx,y114
fnx: GEMDOS 79,2
   move.l d0,-(a6)
y114: rts

   COPIE dta,y115,1
dta: move.l #dtabuf,-(a6)
y115: rts

   COPIE fsd,y116
fsd: move.l (a6)+,-(sp)
   GEMDOS 26,6
y116: rts

   COPIE fop,y107
fop: addq.l #2,a6
   move (a6)+,-(sp)
   move.l (a6)+,-(sp)
   GEMDOS 61,8
   move.l d0,-(a6)
y107: rts

	SAUT
fopsize:
	bsr.s fop				; ouvre le fichier
	bmi.s .erreur
	move.l d0,d7		; garde handle
	clr.l (a6)
	move.l d7,-(a6)
	bsr.s fsk2				; fin de fichier
	bmi.s .erreur
	move.l d0,d6		; garde taille
	clr.l (a6)
	move.l d7,-(a6)
	bsr.s fsk1				; debut de fichier
	bmi.s .erreur
	move.l d6,(a6)		; sinon renvoie la taille
	move.l d7,-(a6)	; et le handle
.erreur:
	rts

   COPIE fsk,y117
fsk: move #1,-(sp)
   addq.l #2,a6
   move (a6)+,-(sp)
   move.l (a6)+,-(sp)
   GEMDOS 66,10
   move.l d0,-(a6)
y117: rts

   COPIE fsk1,y118
fsk1: move #0,-(sp)
   addq.l #2,a6
   move (a6)+,-(sp)
   move.l (a6)+,-(sp)
   GEMDOS 66,10
   move.l d0,-(a6)
y118: rts

   COPIE fsk2,y119
fsk2: move #2,-(sp)
   addq.l #2,a6
   move (a6)+,-(sp)
   move.l (a6),-(sp)
   neg.l (sp)
   GEMDOS 66,10
   move.l d0,(a6)
y119: rts

   SAUT
xv_opnwk:
	moveq #1,d0
	moveq #1,d1		; un couple de plus
	bra ouvrir2

   SAUT
xv_updwk:
	move.l (a6)+,intin	; l'adresse du buffer
   moveq #2,d2
   V5 4,1,0

	COPIE _global,y120,1
_global:
	move.l #global,-(a6)
y120: rts

	COPIE vq_aes,y121,1
vq_aes:
	moveq #0,d1
	ifd LIB
		tst.b aes_flag
		bne.s .lb0
		moveq #-1,d1
		.lb0:
	endif
	move.l d1,-(a6)
y121: rts

   COPIE vsync,y124
vsync: XBIOS 37,2
y124: rts

   SAUT
joyst:
	tst.b is_saga
	beq.s .atari
	st is_saga			; remet FF par d‚faut USB avec tous ses boutons + 2 joyst
	subq.l #1,(a6)+
	beq.s .exit
	bclr #7,is_saga	; 7F, seul le bouton A fonctionne sur l'USB + 2 joyst
.exit:
	rts
.atari:
	move.l joystick(pc),a0
	subq.l #1,(a6)+	; mode 1 ou 2 joysticks
	bne.s .lb2
	move.l #mon_joyst1,(a0)
	move.l #ma_souris,-8(a0)
	rts
.lb2:
	move.l #mon_joyst2,(a0)
	move.l #$40014,-(sp)	; mode de signalisation auto des joysticks
   BIOS 3,6
   rts

   SAUT
mouse:
	tst.b is_saga
	beq.s .atari				; nothing to do on SAGA
	st is_saga					; remet le mode par d‚faut
	rts
;	move.l #$40015,-(sp)	; arret de la signalisation joystick
;   BIOS 3,6
.atari:
   move.l #$40008,-(sp)
   BIOS 3,6							; mode souris relatif
   move.l joystick(pc),a0
   move.l old_joyst,(a0)
   move.l old_mouse,-8(a0)
	rts

joystick: dc.l 3592
	dc.b 0,0

mon_joyst1:
	cmp.b #$FD,(a0)
	beq.s .ok
	cmp.b #$FF,(a0)
	bne.s .exit
.ok:
	move.b 2(a0),d0			; les 4 directions
	lea joystick+5(pc),a0
	and.b #$80,(a0)			; garde le bouton
	or.b d0,(a0)				; ajoute directions
.exit:
	rts

ma_souris:
	cmp.b #$F8,(a0)	; no button
	beq.s .no_fire
	cmp.b #$F9,(a0)	; left
	beq.s .fire
	cmp.b #$FA,(a0)	; right = J1 button
	beq.s .no_fire
	cmp.b #$FB,(a0)	; both = J1 button
	bne.s .exit
.fire:
	bset #7,joystick+5	; set fire 1
	bra.s .exit
.no_fire:
	bclr #7,joystick+5	; clear fire 1
.exit:
	move.l old_mouse,-(sp)	; continue to old vector
	rts

mon_joyst2:
	cmp.b #$FD,(a0)
	bne.s .lb1
	move 1(a0),joystick+4
	rts
.lb1:
	cmp.b #$FF,(a0)
	beq.s .joy1
	cmp.b #$FE,(a0)+
	bne.s .exit
	move.b (a0),joystick+4
	rts
.joy1:
	move.b 2(a0),joystick+5
.exit:
	rts

   SAUT
jx0: moveq #0,d0
	tst.b is_saga
	bne.s .saga
   move.b joystick+4(pc),d1
   and.b #$c,d1
   beq.s .lb1
   moveq #1,d0
   and.b #8,d1
   bne.s .lb1
   neg.l d0
.lb1: move.l d0,-(a6)
   rts
.saga:
	move $dff00a,d1
	bra.s jxcomm

   SAUT
jx1: moveq #0,d0
	tst.b is_saga
	bne.s .saga
   move.b joystick+5(pc),d1
   and.b #$c,d1
   beq.s .lb1
   moveq #1,d0
   and.b #8,d1
.comm:
   bne.s .lb1
   neg.l d0
.lb1: move.l d0,-(a6)
   rts
.saga:
	move $dff00c,d1
jxcomm:
	btst #1,d1
	bne.s .right
	btst #9,d1
	beq.s .lb1				; centre,
	moveq #-1,d0
	bra.s .lb1				; left
.right:
	moveq #1,d0
.lb1:
	move.l d0,-(a6)
	rts


;	move $dff220,d1
;	lsr #8,d1				; RLDU0000
;	and.b #$C0,d1
;	beq.s .lb1
;	moveq #1,d0
;	btst #7,d1
;	bra.s .comm

   SAUT
jy0:
	moveq #0,d0
	tst.b is_saga
	bne.s .saga
   move.b joystick+4(pc),d1
   and.b #3,d1
   beq.s .lb1
   moveq #1,d0
   and.b #2,d1
   bne.s .lb1
   neg.l d0
.lb1: move.l d0,-(a6)
   rts
.saga:
	move $dff00a,d1
	bra.s jycomm

   SAUT
jy1:
	moveq #0,d0
   tst.b is_saga
	bne.s .saga
   move.b joystick+5(pc),d1
   and.b #3,d1
   beq.s .lb1
   moveq #1,d0
   and.b #2,d1
.comm:
   bne.s .lb1
   neg.l d0
.lb1: move.l d0,-(a6)
   rts
.saga:
	move $dff00c,d1
jycomm:
	move d1,d2
	lsr #1,d1
	eor d2,d1
	btst #0,d1
	bne.s .down
	btst #8,d1
	beq.s .lb1				; centre,
	moveq #-1,d0
	bra.s .lb1				; up
.down:
	moveq #1,d0
.lb1:
	move.l d0,-(a6)
	rts

;	move $dff220,d1
;	lsr #8,d1				; RLDU0000
;	and.b #$30,d1
;	beq.s .lb1
;	moveq #1,d0
;	btst #5,d1
;	bra.s .comm

   SAUT
fire0: moveq #0,d0
	tst.b is_saga
	bne.s .saga
	if STE=0
	   tst.b joystick+4(pc)
	else
		tst.b joystick+4
	endif
   bpl.s .lb1
.lb2:
   moveq #1,d0
.lb1: move.l d0,-(a6)
   rts
.saga:
    btst.b  #6,$bfe001        ; check if firebutton 1 is pressed
    bne.s   .lb1              ; not pressed
    bra.s .lb2       			; pressed !

   SAUT
fire1:
	moveq #0,d0
	tst.b is_saga
	bne.s .saga
	if STE=0
	   tst.b joystick+5(pc)
	else
		tst.b joystick+5
	endif
   bpl.s .lb1
.lb2:
   moveq #1,d0
.lb1: move.l d0,-(a6)
   rts
.saga:
	bmi.s .defaut
   btst.b  #7,$bfe001        ; ici mode 7F, un seul bouton A, check if firebutton 1 is pressed
   bne.s   .lb1              ; not pressed
   bra.s .lb2       			; pressed !
.defaut:
	move.w $dff220,d0		; ici mode 7F (2 joyst) tous les boutons.
	and #$0FFF,d0			; uniquement les boutons
	lsr.w #1,d0				; enlŠve bit0 = joystick pr‚sent
	btst #7,$bfe001		; teste aussi le port DB9
	bne.s .lb1				; rien, ok
	bset #0,d0				; sinon, simul le bouton A
	bra.s .lb1				; D0= 0000 00SB 0000 YXBA (start, back, y,x,b,a)


   COPIE mousx,y127,1
mousx:
   GEM_VDI vq_mouse
   moveq #0,d1
   move vq_out+2,d1
   move.l d1,-(a6)
y127: rts

   COPIE mousy,y128,1
mousy:
	GEM_VDI vq_mouse
	moveq #0,d1
	move vq_out+4,d1
   move.l d1,-(a6)
y128: rts

   COPIE mousk,y129,1
mousk:
   GEM_VDI vq_mouse
   move vq_out,d1
   and.l #3,d1
   move.l d1,-(a6)
y129: rts

   COPIE hadr,y130,1
hadr: move.l (a6)+,d1
	if STE=0
   	lea (adresse,d1.l*4),a0
   else
   	lea adresse,a0
   	asl.l #2,d1
   	add.l d1,a0
   endif
   move.l a0,-(a6)
y130: rts

   COPIE super,y131,1
super: clr.l -(sp)
   GEMDOS 32,6
   move.l d0,savpil
y131: rts

   COPIE user,y132,1
user: move.l savpil,-(sp)
   GEMDOS 32,6
y132: rts

   ASS 1
blockgds: move.l a7,topsave
   moveq #0,d2
   if STE=0
   	lea (gblk-1476,pc,d1.w*4),a3
   else
   	add d1,d1
   	add d1,d1
   	lea gblk-1476,a3
   	add d1,a3
   endif
   move.b (a3)+,d3
   move.b (a3)+,d2
   bmi.s .lb4
.lb1: move.l (a6)+,d0
   btst d2,d3
   bne.s .lb2
   move d0,-(sp)
   bra.s .lb3
.lb2: move.l d0,-(sp)
.lb3: dbf d2,.lb1
.lb4: move.b (a3)+,d2
   ext.w d2
   move d2,-(sp)
   trap #1
   move.l topsave,a7
   tst.b (a3)
   beq.s .lb5
   move.l d0,-(a6)
.lb5: rts

   ASS 21
blockbs: move.l a7,topsave
   moveq #0,d2
   if STE=0
	   lea (bblk-1588,pc,d1.w*4),a3
	else
		add d1,d1
		add d1,d1
		lea bblk-1588,a3
		add d1,a3
	endif
   move.b (a3)+,d3
   move.b (a3)+,d2
   bmi.s .lb4
.lb1: move.l (a6)+,d0
   btst d2,d3
   bne.s .lb2
   move d0,-(sp)
   bra.s .lb3
.lb2: move.l d0,-(sp)
.lb3: dbf d2,.lb1
.lb4: move.b (a3)+,d2
   ext.w d2
   move d2,-(sp)
   trap #13
   move.l topsave,a7
   tst.b (a3)
   beq.s .lb5
   move.l d0,-(a6)
.lb5: rts

   ASS 22
blockxbs: move.l a7,topsave
   moveq #0,d2
   if STE=0
	   lea (xblk-1632,pc,d1.w*4),a3
	else
		add d1,d1
		add d1,d1
		lea xblk-1632,a3
		add d1,a3
	endif
   move.b (a3)+,d3
   move.b (a3)+,d2
   bmi.s .lb4
.lb1: move.l (a6)+,d0
   btst d2,d3
   bne.s .lb2
   move d0,-(sp)
   bra.s .lb3
.lb2: move.l d0,-(sp)
.lb3: dbf d2,.lb1
.lb4: move.b (a3)+,d2
   ext.w d2
   move d2,-(sp)
   trap #14
   move.l topsave,a7
   tst.b (a3)
   beq.s .lb5
   move.l d0,-(a6)
.lb5: rts

   NON
ass1: move.l a5,a0
   move.l (a4)+,a5
   jmp (a0)

   COPIE pair,y133,1
pair: move.l topprg,d1
   addq.l #1,d1
   bclr #0,d1
   move.l d1,topprg
y133: rts

	SAUT
aligne: move.l topprg,d1
	move.l (a6)+,d0
	add.l d0,d1
	neg.l d0
	subq.l #1,d1
	and.l d0,d1
	move.l d1,topprg
	rts

	COPIE sizeb,y134
sizeb: moveq #0,d1
   move.l d1,-(a6)
y134: rts

   COPIE sizew,y135
sizew: moveq #1,d1
   move.l d1,-(a6)
y135: rts

   COPIE sizel,y136
sizel: moveq #2,d1
   move.l d1,-(a6)
y136: rts

	COPIE sizef,y136a
sizef: moveq #3,d1
	move.l d1,-(a6)
y136a: rts

   COPIE siz,y139,1
siz: move.l (a6)+,d1
	bpl.s .ok
	moveq #0,d1				; si n‚gatif, revient … z‚ro
.ok:
	moveq #3,d0
	cmp.l d1,d0				; si >3 revient … 3
	bpl.s .ok2
	move.l d0,d1
.ok2:
   move d1,sizeptr
y139: rts

   SAUT
pre1: move.l (a6),a1		; -(@
   moveq #0,d1
   move.l (a1),a2
   move sizeptr,d0
   bne.s .lb1
   move.b -(a2),d1		; .b
   bra.s .fin
.lb1: subq #1,d0
   bne.s .lb2
   move -(a2),d1			; .w
   bra.s .fin
.lb2: subq #1,d0
	bne.s .lb3
	move.l -(a2),d1		; .l
	bra.s .fin
.lb3:
	move.l -(a2),(a6)		; .f
	move.l -(a2),-(a6)
	bra.s .exit
.fin:
   move.l d1,(a6)
.exit:
   move.l a2,(a1)
   rts

   SAUT
pre2: move.l (a6)+,a1	; -(!
   move.l (a6)+,d1
   move.l (a1),a2
   move sizeptr,d0
   bne.s .lb1
   move.b d1,-(a2)		; .b
   bra.s .fin
.lb1: subq #1,d0
   bne.s .lb2
   move d1,-(a2)			; .w
   bra.s .fin
.lb2:
	subq #1,d0
	beq.s .lb3
	move.l (a6)+,-(a2)	; .f
.lb3:
	move.l d1,-(a2)		; .l
.fin: move.l a2,(a1)
   rts

   SAUT
pre3: move.l (a6),a1		; +(@
   moveq #0,d1
   move.l (a1),a2
   move sizeptr,d0
   bne.s .lb1
   addq.l #1,a2
   move.b (a2),d1			; .b
   bra.s .fin
.lb1: subq #1,d0
   bne.s .lb2
   addq.l #2,a2
   move (a2),d1			; .w
   bra.s .fin
.lb2: subq #1,d0
	bne.s .lb3
	addq.l #4,a2			; .l
   move.l (a2),d1
   bra.s .fin
.lb3:
	addq.l #8,a2
	move.l 4(a2),(a6)		; .f
	move.l (a2),-(a6)
	bra.s .exit
.fin:
   move.l d1,(a6)
.exit:
	move.l a2,(a1)
   rts

   SAUT
pre4: move.l (a6)+,a1	; +(!
   move.l (a6)+,d1
   move.l (a1),a2
   move sizeptr,d0
   bne.s .lb1
   addq.l #1,a2
   move.b d1,(a2)			; .b
   bra.s .fin
.lb1: subq #1,d0
   bne.s .lb2
   addq.l #2,a2
   move d1,(a2)			; .w
   bra.s .fin
.lb2: subq #1,d0
	bne.s .lb3
	addq.l #4,a2
   move.l d1,(a2)			; .l
   bra.s .fin
.lb3:
	addq.l #8,a2
	move.l d1,(a2)			; .f
	move.l (a6)+,4(a2)
.fin: move.l a2,(a1)
   rts

   SAUT
post1: move.l (a6),a1	; )-@
   move.l (a1),a2
   moveq #0,d1
   move sizeptr,d0
   bne.s .lb1
   move.b (a2),d1			; .b
   subq.l #1,a2
   bra.s .fin
.lb1: subq #1,d0
   bne.s .lb2
   move (a2),d1			; .w
   subq.l #2,a2
   bra.s .fin
.lb2: subq #1,d0
	bne.s .lb3
	move.l (a2),d1			; .l
   subq.l #4,a2
   bra.s .fin
.lb3:
	move.l 4(a2),(a6)		; .f
	move.l (a2),-(a6)
	subq.l #8,a2
	bra.s .exit
.fin:
   move.l d1,(a6)
.exit:
	move.l a2,(a1)
   rts

   SAUT
post2: move.l (a6)+,a1		; )-!
   move.l (a6)+,d1
   move.l (a1),a2
   move sizeptr,d0
   bne.s .lb1
   move.b d1,(a2)				; .b
   subq.l #1,a2
   bra.s .fin
.lb1: subq #1,d0
   bne.s .lb2
   move d1,(a2)				; .w
   subq.l #2,a2
   bra.s .fin
.lb2: move.l d1,(a2)			; .l et .f
	subq #1,d0
	bne.s .lb3
   subq.l #4,a2				; .l
   bra.s .fin
.lb3:
	move.l (a6)+,4(a2)		; .f
	subq.l #8,a2
.fin: move.l a2,(a1)
   rts

   SAUT
rcl_ind: move.l (a6),a1		; )@
   move.l (a1),a2
   moveq #0,d1
   move sizeptr,d0
   bne.s .lb1
  	move.b (a2),d1				; .b
   bra.s .fin
.lb1: subq #1,d0
   bne.s .lb2
   move (a2),d1				; .w
   bra.s .fin
.lb2: subq #1,d0
	bne.s .lb3
	move.l (a2),d1				; .l
.fin:
   move.l d1,(a6)
	rts
.lb3:
	move.l 4(a2),(a6)			; .f
	move.l (a2),-(a6)
	rts

   SAUT
sto_ind: move.l (a6)+,a1	; )!
   move.l (a6)+,d1
   move.l (a1),a2
   move sizeptr,d0
   bne.s .lb1
   move.b d1,(a2)				; .b
   rts
.lb1: subq #1,d0
   bne.s .lb2
   move d1,(a2)				; .w
   rts
.lb2: move.l d1,(a2)+		; .l et .f
	subq #1,d0
	beq.s .lb3
	move.l (a6)+,(a2)			; .f
.lb3:
	rts

   SAUT
post3: move.l (a6),a1	; )+@
   move.l (a1),a2
   moveq #0,d1
   move sizeptr,d0
   bne.s .lb1
   move.b (a2)+,d1		; .b
   bra.s .fin
.lb1: subq #1,d0
   bne.s .lb2
   move (a2)+,d1			; .w
   bra.s .fin
.lb2: move.l (a2)+,d1	; .l et .f
	subq #1,d0
	beq.s .fin
	move.l (a2)+,(a6)		; .f
	move.l d1,-(a6)
	bra.s .exit
.fin:
   move.l d1,(a6)
.exit:
	move.l a2,(a1)
   rts

   SAUT
post4: move.l (a6)+,a1		; )+!
   move.l (a6)+,d1
   move.l (a1),a2
   move sizeptr,d0
   bne.s .lb1
   move.b d1,(a2)+			; .b
   bra.s .fin
.lb1: subq #1,d0
   bne.s .lb2
   move d1,(a2)+				; .w
   bra.s .fin
.lb2: move.l d1,(a2)+		; .l et .f
	subq #1,d0
	beq.s .fin
	move.l (a6)+,(a2)+		; .f
.fin: move.l a2,(a1)
   rts

   COPIE cvirg,y140,1		; c,
cvirg: move.l (a6)+,d1
   move.l topprg,a2
   move.b d1,(a2)+
   move.l a2,topprg
y140:  rts

	COPIE fvirg,y140a,1		; f,
fvirg: move.l topprg,a2
	move.l (a6)+,(a2)+
	move.l (a6)+,(a2)+
	move.l a2,topprg
y140a: rts

   COPIE wmulsto,y141
wmulsto: move.l (a6)+,a1
   move.l (a1),d0
   move.l (a6)+,d1
   muls d1,d0
   move.l d0,(a1)
y141: rts

   COPIE wdivsto,y142
wdivsto: move.l (a6)+,a1
   move.l (a1),d0
   move.l (a6),d1
   divs d1,d0
   ext.l d0
   move.l d0,(a1)
y142: rts

   COPIE mulsto2,y143
mulsto2: move.l (a6)+,a1
   move.l (a1),d1
   asl.l #1,d1
   move.l d1,(a1)
y143: rts

   COPIE divsto2,y144
divsto2: move.l (a6)+,a1
   move.l (a1),d1
   asr.l #1,d1
   move.l d1,(a1)
y144: rts

   COPIE deces,y145,1
deces: move.l (a6)+,a1
   move.l topprg,a3
.lb1: move.b (a1)+,(a3)+
   bne.s .lb1
   move.l a3,topprg
y145: rts

   SAUT
segferme: move.l (a6)+,d0
   move.l (a6)+,d1
   move.l (a6),d2
   moveq #0,d3
   sub.l d2,d1
   beq.s .lb0
   bpl.s .lb1
   sub.l d2,d0
   bmi.s .fin
.lb0: moveq #1,d3
.fin: move.l d3,(a6)
   rts
.lb1: sub.l d2,d0
   ble.s .lb0
   bra.s .fin

   SAUT
segouvert: move.l (a6)+,d0
   move.l (a6)+,d1
   move.l (a6),d2
   moveq #0,d3
   sub.l d2,d1
   beq.s .fin
   bpl.s .lb1
   sub.l d0,d2
   bpl.s .fin
.lb0: moveq #1,d3
.fin: move.l d3,(a6)
   rts
.lb1: sub.l d2,d0
   bmi.s .lb0
   bra.s .fin

   COPIE list,y146,1
list: move.l a6,lst
y146: rts

   ASS 26
ndo:
	move.l (a6)+,d0		; taille boucle
	bne.s .lb0				; boucle normale
	add.w (a5)+,a5			; boucle vide, saute aprŠs nloop
	rts
.lb0:
	addq.l #2,a5			; saute l'offset
   moveq #0,d1
   subq.l #1,d0
   swap d0
   movem.l d0-d1/a5,-(a4)
   rts

   ASS 27
nloop: subq #1,(a4)
   bcs.s .lb1
   move.l 8(a4),a5
   rts
.lb1: subq #1,2(a4)
   bcs.s .lb2
   move.l 8(a4),a5
   rts
.lb2: add.w #12,a4
   rts

	ASS 32
dolist:
	move.l lst,d1
	beq.s .lb6			; va au mode tableau
	clr.l lst
   move.l d1,d2		; ici calcule le nombre de valeurs sur la pile
   sub.l a6,d2
   asr.l #2,d2
   bne.s .lb2			; boucle normale
   bra.s .lb5
.lb6:
	move.l (a6)+,d0	; nombre de valeurs du tableau
	bne.s .lb2			; boucle normale
	addq.l #4,a6		; vire l'adresse du tableau
.lb5:
	add.w (a5)+,a5		; saute la boucle vide
	rts
.lb2:
	addq.l #2,a5
	move.l a5,-(a4)	; adresse o— revenir pour le d‚but de boucle
   move.l #indptr,a1
   addq.l #4,(a1)
   move.l (a1),a1
   move.l lstptr,a0
   tst.l d1
   bne.s .lb0
   addq.l #4,lstptr
   move.l -4(a0),(a0)
   move.l d0,-(a4)		; n valeurs dans le tableau
   move.l (a6)+,(a1)		; adresse tableau
   clr.l -(a4)				; index … z‚ro au d‚but
   rts
.lb0:
   move.l d1,a6
   move.l d2,-(a4)		; nombre de valeurs sur la pile
   clr.l -(a4)				; index … z‚ro
   subq #1,d2
   move.l -4(a0),(a1)
   move.l (a1),a1
   move.l d1,a2
.lb1: move.l -(a2),(a1)+
   dbf d2,.lb1
   move.l a1,(a0)
   addq.l #4,lstptr
   rts

   ASS 31
lloop: addq.l #1,(a4)	; augmente l'index
	move.l (a4),d0
	cmp.l 4(a4),d0			; et compare avec "n" valeurs
   bcc.s .lb1				; on arrive … la fin!
   move.l indptr,a1
   addq.l #4,(a1)			; nouvel ‚l‚ment
   move.l 8(a4),a5		; retour au d‚but de boucle
   rts
.lb1: add.w #12,a4		; vide la pile, fin de boucle
   subq.l #4,lstptr
   subq.l #4,indptr
   rts

dlcomp:
   move.l #indptr,a1
   addq.l #4,(a1)
   move.l (a1),a1
   move.l lstptr,a0
	tst.l d1			; lst
   bne.s .lb0
   addq.l #4,lstptr
   move.l -4(a0),(a0)
   move.l d0,-(a4)
   clr.l -(a4)
   move.l (a6)+,(a1)
   rts
.lb0:
   move.l d1,a6
   move.l d2,-(a4)
   clr.l -(a4)
   subq #1,d2
   move.l -4(a0),(a1)
   move.l (a1),a1
   move.l d1,a2
.lb1: move.l -(a2),(a1)+
   dbf d2,.lb1
   move.l a1,(a0)
   addq.l #4,lstptr
   rts

   COPIE remember,y147,1
remember: addq.l #4,remb
   move.l remb,a1
   move.l topprg,(a1)
y147: rts

   COPIE restore,y148,1
restore: move.l remb,a1
   tst.l (a1)
   bne.s .lb1
   move.l program,topprg
   bra.s y148
.lb1: move.l (a1),topprg
   subq.l #4,remb
y148: rts

   NON
struct: move #1,stt
   move.l #sttdata,sttptr
   rts

alloc: move.l szone,a0    ; d0:taille  --> d0:adresse
   move.l topmem,a1       ; utilise d0,a0,d1,a1,d2
.lb0: move.l (a0)+,d1
   bmi.s .lb6
   cmp.l d0,d1
   bpl.s .lb1
   sub.l d1,a1
   sub.l (a0)+,a1
   bra.s .lb0
.lb1: beq.s .lb3
.lb2: sub.l d1,a1
   add.l d0,(a0)
   sub.l d0,-(a0)
   move.l a1,d0
.lb5: rts
.lb3: move.l szone,d2
   addq.l #4,d2
   cmp.l d2,a0
   beq.s .lb2
   sub.l d1,a1
   add.l (a0)+,d1
   move.l a1,d0
   move.l a0,a1
   sub.w #12,a1
   add.l d1,(a1)+
.lb4: move.l (a0)+,(a1)+
   bmi.s .lb5
   move.l (a0)+,(a1)+
   bra.s .lb4
.lb6: sub.l d0,botmem
   add.l d0,-8(a0)
   move.l botmem,d0
   rts

; utilise a0,a1,a2
; et d0,d1

libere: move.l (a2),d0
   sub.l a2,d0
   add.l 4(a2),d0
   move.l szone,a0    ; d0:taille et a2:adresse
   move.l topmem,a1
.lb0: move.l (a0)+,d1
   bmi.s .lb3
   sub.l d1,a1
   sub.l (a0)+,a1
   cmp.l a1,a2
   bmi.s .lb0
   beq.s .lb4
   move.l -(a0),d1
   add.l d1,a1
   add.l d0,a2
   cmp.l a1,a2
   bne.s .lb1
   sub.l d0,(a0)
   add.l d0,-(a0)
   rts
.lb1: sub.l a2,a1
   move.l a1,(a0)+
   sub.l a1,d1
   sub.l d0,d1
.lb2: move.l (a0),a2
   move.l d0,(a0)+
   bmi.s .lb3
   move.l d1,d0
   move.l a2,d1
   bra.s .lb2
.lb3: rts
.lb4: move.l -(a0),d1
   add.l d1,a1
   add.l d0,a2
   cmp.l a1,a2
   beq.s .lb6
   sub.l d0,(a0)+
   tst.l (a0)
   bmi.s .lb5
   add.l d0,(a0)
   rts
.lb5: add.l d0,botmem
   rts
.lb6: add.l -(a0),d0
   move.l a0,a1
   addq.l #8,a1
   tst.l (a1)
   bmi.s .lb8
   add.l d0,(a1)
.lb7: move.l (a1)+,(a0)+
   bmi.s .lb3
   move.l (a1)+,(a0)+
   bra.s .lb7
.lb8: add.l d0,botmem
   cmp.l szone,a0
   bne.s .lb9
   clr.l (a0)+
   clr.l (a0)
   rts
.lb9: move.l (a1),(a0)
   rts

   NON
name: lea adresse,a1
   move (a5)+,d1
   move.l topprg,a2
   if STE=0
   	move.l a2,0(a1,d1.w*4)
   else
   	add d1,d1
   	add d1,d1
   	add d1,a1
   	move.l a2,(a1)
   endif
   move.l sttptr,d1
   move.l #sttdata,a0
   sub.l a0,d1
   move #140,(a2)+
   clr.l (a2)+
   move.l d1,(a2)+
   clr.l (a2)+
   move.l a2,-12(a2)
   lsr.l d1
   subq.l #1,d1
.lb1: move (a0)+,(a2)+
   dbf d1,.lb1
   move.l a2,topprg
   clr stt
   rts

   COPIE sizeof,y149
sizeof: if STE=0
		move.l ([a6],4.w),(a6)
	else
		move.l (a6),a0
		move.l 4(a0),(a6)
	endif
y149: rts

   SAUT
schain: move.l (a6),a3
   move.l 4(a3),d4
   add.l #12,d4
   move.l d4,d0
   bsr alloc
   move.l d0,(a6)
   move.l d0,a0
   addq.l #4,a0
   sub.l #12,d4
   move.l d4,(a0)+
   move.l 8(a3),(a0)+
   move.l a0,-12(a0)
   move.l d0,8(a3)
   move.l (a3),a3
   lsr.l d4
   subq.l #1,d4
.lb2: move (a3)+,(a0)+
   dbf d4,.lb2
   rts

   SAUT
screate: move.l (a6),a3
   move.l 4(a3),d4
   addq.l #8,d4
   move.l d4,d0
   bsr alloc
   move.l d0,(a6)
   move.l d0,a0
   addq.l #4,a0
   subq.l #8,d4
   move.l d4,(a0)+
   move.l a0,-8(a0)
   lsr.l d4
   subq.l #1,d4
   move.l (a3),a3
.lb2: move (a3)+,(a0)+
   dbf d4,.lb2
   rts

   SAUT
unchain: bsr.s previous
   UP
   move.l d1,a1
   move.l 8(a1),8(a0)
   move.l d1,a2
   bra libere

   COPIE next,y150
next: if STE=0
			move.l ([a6],8.w),(a6)
		else
			move.l (a6),a0
			move.l 8(a0),(a6)
		endif
y150: rts

   COPIE previous,y151
previous: move.l (a6)+,d1
.lb1: move.l (a6),a0
   move.l 8(a0),(a6)
   beq.s y151
   cmp.l (a6),d1
   bne.s .lb1
   move.l a0,(a6)
y151: rts

   COPIE sdel,y152,1
sdel: move.l (a6)+,a2
   jsr libere
y152: rts

   COPIE view,y153,1
view: move.l (a6),-(a6)
   jsr point
y153: rts

   SAUT
empty: move.l (a6),a3
.lb1: move.l 8(a3),d0
   beq.s .fin
   move.l d0,a3
   move.l d0,a2
   bsr libere
   bra.s .lb1
.fin: move.l (a6)+,a3
   clr.l 8(a3)
   rts

   COPIE inchain,y154
inchain: move.l (a6)+,a2
   move.l (a6)+,a1
   move.l 8(a1),8(a2)
   move.l a2,8(a1)
y154: rts

   SAUT
pchain: move.l (a6)+,a3
   move.l 4(a3),d4
   add.l #12,d4
   move.l d4,d0
   bsr alloc
   move.l (a6)+,a1
   move.l d0,a0
   addq.l #4,a0
   sub.l #12,d4
   move.l d4,(a0)+
   move.l (a1),(a0)+
   move.l a0,-12(a0)
   move.l d0,(a1)
   lsr.l d4
   subq.l #1,d4
   move.l (a3),a3
.lb2: move (a3)+,(a0)+
   dbf d4,.lb2
   rts

   SAUT
punchain: move.l (a6),a3
   move.l 4(a6),a1
   cmp.l (a1),a3
   beq.s .lb1
   move.l (a1),4(a6)
   bra unchain
.lb1: move.l 8(a3),(a1)
   move.l a3,a2
   bsr libere
   addq.l #8,a6
   rts

   COPIE pinchain,y155
pinchain: move.l (a6)+,a2
   move.l (a6),a1
   move.l (a1),8(a2)
   move.l a2,(a1)
y155: rts

   COPIE ssto,y156
ssto: move.l (a6)+,a2
   move.l (a6),a1
   move.l 2(a1),d1
   move.l d1,2(a2)
   move.l (a1),a1
   move.l (a2),a2
   lsr.l d1
   subq.l #1,d1
.lb1: move (a1)+,(a2)+
   dbf d1,.lb1
y156: rts

   ASS 28
fast: move.l #fastexe,(sp)
   move.w #1,isfast
   rts

   ASS 28
slow: move.l #slowexe,(sp)
   clr.w isfast
   rts

   COPIE start,y157,1
start: move.l #accudat,a0
   clr.b (a0)
   move.l a0,accuptr
y157: rts

   COPIE pushs,y158,1
pushs: move.l (a6)+,a0
   move.l accuptr,a2
.lb1: move.b (a0)+,(a2)+
   bne.s .lb1
   subq.l #1,a2
   move.l a2,accuptr
y158: rts

   COPIE pushv,y159,1
pushv: st ecran
   jsr point
   sf ecran
   move.l accuptr,a2
.lb1: move.b (a1)+,(a2)+
   bne.s .lb1
   subq.l #1,a2
   move.l a2,accuptr
y159: rts

   COPIE pushc,y160,1
pushc: move.l accuptr,a0
   addq.l #3,a6
   move.b (a6)+,(a0)+
   clr.b (a0)
   move.l a0,accuptr
y160: rts

   SAUT
display: lea accudat,a0
	bsr write_str
   rts

   COPIE getfmt,y162,1
getfmt: move.l #accudat,a0
   if STE=0
   	clr.b ([accuptr])
   else
   	move.l accuptr,a1
   	clr.b (a1)
   endif
   move.l #pad+2,a1
   move.l a1,-(a6)
.lb0: move.b (a0)+,(a1)+
   bne.s .lb0
y162: rts

; " masque" dir affiche par d‚faut fichier + taille
; dans le masque on peut sp‚cifier au d‚but, entre parenthŠses, d et/ou t pour obtenir en plus date et heure
; ex: " (dt)*.S" dir

   SAUT
dir: move #-1,-(sp)
	moveq #0,d7			; d‚faut pas d'option
   move.l (a6)+,a3
   cmp.b #'(',(a3)
   bne.s .lb0
   addq.l #1,a3
.options:
	move.b (a3)+,d0
	beq.s .lb0
	cmp.b #")",d0
	beq.s .lb0
	and #$DF,d0			; en majuscule
	cmp.b #'D',d0		; date ?
	bne.s .op1
	bset #0,d7
	bra.s .options
.op1:
	cmp.b #'T',d0
	bne.s .op2
	bset #1,d7
	bra.s .options
.op2:
	bra.s .options
.lb0:
	move d7,.diropt
   move.l a3,-(sp)
   GEMDOS 78,8
.lb1: tst.l d0
   bne.s .fin
   bsr cr
   GEMDOS $2f,2
   move.l d0,a3
   add.w #28,a3
   lea -6(a3),a0
   moveq #0,d0
   move (a0)+,d0				; time
   move.l d0,-(a6)
   move (a0)+,d0				; date
   move.l d0,-(a6)
   move.l (a0)+,-(a6)		; size
   move #$2020,(a3)+
   moveq #14,d1
.lb2: tst.b (a3)+
   dbeq d1,.lb2
   bne.s .lb4
   subq.l #1,a3
.lb3: move.b #32,(a3)+
   dbf d1,.lb3
   clr.b (a3)
.lb4: bsr write_str
	lea tamp+40,a3
	move.l #$20202020,d0
	move.l d0,-(a3)
	move.l d0,-(a3)
	move.l d0,-(a3)
   st ecran
   bsr dpt		; en decimal
   move.l a3,a0
   bsr write_str
   moveq #0,d0		; bit de la date
	bsr.s .opt
	moveq #1,d0		; bit de l'heure
	bsr.s .opt
   sf ecran
   GEMDOS 79,2
   bra.s .lb1
.fin: rts
.opt:
	btst d0,.diropt+1(pc)
	bne.s .opt1
	addq.l #4,a6	; si le bit est … z‚ro, on d‚pile
	rts
.opt1:
	move.l d0,-(sp)
	bsr spc
	tst.l (sp)+
	bne.s .opt2
	bset #7,(a6)
	bsr datetostr
	bra.s .optcom
.opt2:
	bsr timetostr
.optcom:
	move.l (a6)+,a0
	bsr write_str
	rts
.diropt: dc.w 0

   SAUT
setplus: move.l (a6)+,a0
   move.l (a6),a1
   move.l #setdat,a2
   move.l a2,(a6)
   move.l (a0)+,(a2)+
   addq.l #2,a1
   move (a1)+,d0
   move d0,d1
   lsr #4,d0
   and #$f,d1
   bne.s .lb1
   subq #1,d0
.lb1: move (a0)+,d1
   or (a1)+,d1
   move d1,(a2)+
   dbf d0,.lb1
   rts

   SAUT
setfois: move.l (a6)+,a0
   move.l (a6),a1
   move.l #setdat,a2
   move.l a2,(a6)
   move.l (a0)+,(a2)+
   addq.l #2,a1
   move (a1)+,d0
   move d0,d1
   lsr #4,d0
   and #$f,d1
   bne.s .lb1
   subq #1,d0
.lb1: move (a0)+,d1
   and (a1)+,d1
   move d1,(a2)+
   dbf d0,.lb1
   rts

   SAUT
setmoins: move.l (a6)+,a0
   move.l (a6),a1
   move.l #setdat,a2
   move.l a2,(a6)
   move.l (a0)+,(a2)+
   addq.l #2,a1
   move (a1)+,d0
   move d0,d1
   lsr #4,d0
   and #$f,d1
   bne.s .lb1
   subq #1,d0
.lb1: move (a0)+,d1
   not d1
   and (a1)+,d1
   move d1,(a2)+
   dbf d0,.lb1
   rts

   SAUT
card: move.l (a6),a0
   moveq #0,d3
   addq.l #2,a0
   move (a0)+,d0
   move d0,d1
   lsr #4,d0
   and #$f,d1
   bne.s .lb1
   subq.l #1,d0
.lb1: move (a0)+,d4
   beq.s .lb4
   moveq #15,d5
.lb2: btst d5,d4
   beq.s .lb3
   addq.l #1,d3
.lb3: dbf d5,.lb2
.lb4: dbf d0,.lb1
   move.l d3,(a6)
   rts

   SAUT
setegal: move.l (a6)+,a0
   move.l (a6),a1
   moveq #0,d2
   addq.l #4,a0
   addq.l #2,a1
   move (a1)+,d0
   move d0,d1
   lsr #4,d0
   and #$f,d1
   bne.s .lb1
   subq #1,d0
.lb1: cmp (a1)+,(a0)+
   dbne d0,.lb1
   bne.s .lb2
   moveq #1,d2
.lb2: move.l d2,(a6)
   rts

   SAUT
setin: move.l (a6)+,a1
   move.l (a6),a0
   moveq #0,d2
   addq.l #4,a0
   addq.l #2,a1
   move (a1)+,d0
   move d0,d1
   lsr #4,d0
   and #$f,d1
   bne.s .lb1
   subq #1,d0
.lb1: move (a0),d1
   and (a1)+,d1
   cmp (a0)+,d1
   dbne d0,.lb1
   bne.s .lb2
   moveq #1,d2
.lb2: move.l d2,(a6)
   rts

   SAUT
elmtrcl: move.l (a6)+,a0
   move.l (a6),d6
   moveq #0,d3
   moveq #0,d7
   move (a0)+,d7
   move.l d7,(a6)
   move (a0)+,d0
   move d0,d1
   lsr #3,d0
   and #7,d1
   bne.s .lb1
   subq.l #1,d0
.lb1: move.b (a0)+,d4
   beq.s .lb4b
   moveq #7,d5
   moveq #-1,d2
.lb2: addq #1,d2
   btst d2,d4
   bne.s .lb3
   and #0,ccr
   bra.s .lb4
.lb3: addq.l #1,d3
   cmp d6,d3
.lb4: dbeq d5,.lb2
   beq.s .lb5
.lb4b: addq.l #8,d7
   dbf d0,.lb1
   subq.l #1,(a6)
   rts
.lb5: add d2,d7
   move.l d7,(a6)
   rts

   COPIE elmtplus,y163
elmtplus: move.l (a6)+,a0
   move.l (a6)+,d1
   sub (a0),d1
   move d1,d0
   lsr #3,d0
   and #7,d1
   bset d1,4(a0,d0.w)
y163: rts

   COPIE elmtmoins,y164
elmtmoins: move.l (a6)+,a0
   move.l (a6)+,d1
   sub (a0),d1
   move d1,d0
   lsr #3,d0
   and #7,d1
   bclr d1,4(a0,d0.w)
y164: rts

   COPIE elmtin,y165
elmtin: move.l (a6)+,a0
   move.l (a6),d1
   moveq #0,d2
   sub (a0),d1
   move d1,d0
   lsr #3,d0
   and #7,d1
   btst d1,4(a0,d0.w)
   beq.s .lb1
   moveq #1,d2
.lb1: move.l d2,(a6)
y165: rts

   COPIE initset,y166,1
initset: move.l (a6)+,a1
   move.l #setdat,a2
   move (a1)+,(a2)+
   move (a1),d0
   move d0,(a2)+
   move d0,d1
   lsr #4,d0
   and #$f,d1
   bne.s .lb1
   subq #1,d0
.lb1: clr (a2)+
   dbf d0,.lb1
y166: rts

   COPIE setsto,y167
setsto: move.l (a6)+,a2
   move.l (a6)+,a1
   move (a1)+,(a2)+
   move (a1)+,d0
   move d0,(a2)+
   move d0,d1
   lsr #4,d0
   and #$f,d1
   bne.s .lb1
   subq.l #1,d0
.lb1: move (a1)+,(a2)+
   dbf d0,.lb1
y167: rts

   COPIE pads,y168,1
pads: move.l #setdat,-(a6)
y168: rts

   NON
et1: move (a5),d1
   move.l (a4)+,a5
   ext.l d1
   move.l d1,-(a6)
   rts

edb: dc.l edbuf

; ****************** nombres r‚els **************************
	if STE=0

is_fpu: dc.w $FF00	; FF if 68881/2 detected

   COPIE flint,y400
flint: fmove.d (a6)+,fp0
   fmove.l fp0,-(a6)
y400: rts

   COPIE intfl,y401
intfl: fmove.l (a6)+,fp0
   fmove.d fp0,-(a6)
y401: rts

   COPIE int,y402
int: fintrz.d (a6),fp0
   fmove.d fp0,(a6)
y402: rts

   COPIE sincos,y403
sincos:
   fsincos.d (a6),fp0:fp1
   fmove.d fp1,(a6)
   fmove.d fp0,-(a6)
y403: rts

   COPIE sin,y404
sin:
   fsin.d (a6),fp0
   fmove.d fp0,(a6)
y404: rts

   COPIE cos,y405
cos:
   fcos.d (a6),fp0
   fmove.d fp0,(a6)
y405: rts

   COPIE tan,y406
tan:
   ftan.d (a6),fp0
   fmove.d fp0,(a6)
y406: rts

   COPIE atn,y407
atn:
   fatan.d (a6),fp0
   fmove.d fp0,(a6)
y407: rts

  COPIE sinh,y404h
sinh:
   fsinh.d (a6),fp0
   fmove.d fp0,(a6)
y404h: rts

   COPIE cosh,y405h
cosh:
   fcosh.d (a6),fp0
   fmove.d fp0,(a6)
y405h: rts

   COPIE tanh,y406h
tanh:
   ftanh.d (a6),fp0
   fmove.d fp0,(a6)
y406h: rts

   COPIE atanh,y407h
atanh:
   fatanh.d (a6),fp0
   fmove.d fp0,(a6)
y407h: rts

   COPIE asin,y407a
asin:
   fasin.d (a6),fp0
   fmove.d fp0,(a6)
y407a: rts

   COPIE acos,y407b
acos:
   facos.d (a6),fp0
   fmove.d fp0,(a6)
y407b: rts

   SAUT
asinh:
	fmovecr #50,fp0	; 1
_asinh_acosh:
	fmove.d (a6),fp1
	fmove fp1,fp2
	fmul fp1,fp1		; x^2
	fadd fp1,fp0		; x^2+/-1
	fsqrt fp0				; sqr(x^2+/-1)
	fadd fp0,fp2		; x+sqr(x^2+/-1)
	flogn fp2
   fmove.d fp2,(a6)
	rts

   SAUT
acosh:
	fmovecr #50,fp0
	fneg fp0				; -1
	bra.s _asinh_acosh

   COPIE carre,y408
carre:
   fmove.d (a6),fp0
   fmul.x fp0,fp0
   fmove.d fp0,(a6)
y408: rts

   COPIE expo,y409
expo:
   fetox.d (a6),fp0
   fmove.d fp0,(a6)
y409: rts

   COPIE loga,y410
loga:
   flogn.d (a6),fp0
   fmove.d fp0,(a6)
y410: rts

   COPIE sqr,y411
sqr:
   fsqrt.d (a6),fp0
   fmove.d fp0,(a6)
y411: rts

   COPIE fdiv,y412
fdiv:
   fmove.d 8(a6),fp0
   fdiv.d  (a6)+,fp0
   fmove.d fp0,(a6)
y412: rts

   COPIE ffois,y413
ffois:
   fmove.d (a6)+,fp0
   fmul.d  (a6) ,fp0
   fmove.d fp0  ,(a6)
y413: rts

   COPIE fplus,y414
fplus:
   fmove.d (a6)+,fp0
   fadd.d  (a6) ,fp0
   fmove.d fp0  ,(a6)
y414: rts

   COPIE fmoins,y415
fmoins:
   fmove.d 8(a6),fp0
   fsub.d  (a6)+,fp0
   fmove.d fp0,(a6)
y415: rts

   COPIE inv,y416
inv:
   fmovecr #50,fp0          ; 1
   fdiv.d (a6),fp0
   fmove.d fp0,(a6)
y416: rts

   COPIE round,y417
round:
   fint.d (a6),fp0
   fmove.d fp0,(a6)
y417: rts

   COPIE frac,y418
frac:
   fmove.d (a6),fp0
   fintrz.x fp0,fp1
   fsub.x fp1,fp0
   fmove.d fp0,(a6)
y418: rts

copro: dc.l 0,0,0,0

subplus: movem.l d0-d3,copro
   fmove.d copro,fp0
   fadd.d  copro+8 ,fp0
   fmove.d fp0,copro
   movem.l copro,d0-d1
   rts

submul: movem.l d0-d3,copro
   fmove.d copro,fp0
   fmul.d  copro+8,fp0
   fmove.d fp0,copro
   movem.l copro,d0-d1
   rts

subdiv: movem.l d0-d3,copro
   fmove.d copro,fp0
   fdiv.d  copro+8,fp0
   fmove.d fp0,copro
   movem.l copro,d0-d1
   rts

	; pour les valeurs de -1/e … 0, renvoie la valeur secondaire de -1 … -inf
	SAUT
lambert1:
	tst.b (a6)
	bpl.s lambert		; si a>0, branche principale
	fmove.d (a6)+,fp4	; "a" de x*exp(x) = a
	fabs fp4,fp0		; x positif
	flogn fp0			; valeur de d‚part Ln(-x)
	bra.s _lamb_com

	; pour des valeurs de -1/e … 0, renvoie la valeur principale de -1 … 0
	; pour les valeurs positives, solution unique de 0 … +inf
	SAUT
lambert:
	fmove.d (a6)+,fp4	; "a" de x*exp(x) = a
	flognp1 fp4,fp0	; valeur initiale log(a+1)
_lamb_com:
	moveq #12,d0		; 13 it‚rations semble bien fonctionner
.lb0:
	fmove fp0,fp5		; pour comparaison
	fetox fp0,fp1		; fp1=e(x)
	fmove fp1,fp2
	fmul fp0,fp2		; fp2=x*e(x)
	fmove fp2,fp3
	fadd fp1,fp3		; fp3=x*e(x)+e(x) = d‚riv‚e de la fonction
	fsub fp4,fp2		; fp2 = x*e(x)-a = valeur de la fonction
	fdiv fp3,fp2		; epsilon
	fsub fp2,fp0		; x'=x-epsilon, nouvelle valeur
	fcmp fp0,fp5
	fbeq .exit
	dbf d0,.lb0
.exit:
	fmove.d fp0,-(a6)
	rts

; ************************ fin *****************
	else
; *************Calcul r‚el sans coprocesseur


FPCIR equ $fffffa40
FPCTL equ $fffffa42
FPCMD equ $fffffa4a
FPOP  equ $fffffa50
FPCCR equ $fffffa4e

test_fpu:
	sf is_fpu
	move #0,cookie_flag
	move.l #'_FPU',mot
	pea _cookie(pc)
	XBIOS 38,6
	tst cookie_flag
	beq.s .fin
	cmp #1,cookie_val
	bne.s .fin
	st is_fpu
.fin:
	rts

;
;	pea _test_fpu(pc),
;	XBIOS 38,6
;	rts
;
;_test_fpu:
;	sf is_fpu
;	rts
;
;	move.l $8.w,a1
;	move.l #.my_bus,$8.w
;	st is_fpu
;	tst.w FPCIR.w		; provoque erreur bus si FPU absent
;	clr.w FPCTL.w
;	move #$9000,FPCMD.w
;.lb0:
;	move FPCIR.w,d0
;	and #$BFFF,d0
;	cmp #$9504,d0
;	bne.s .lb0
;	move.l #$00000000,FPOP.w
;.fin:
;	move.l a1,$8.w
;	rts
;.my_bus:
;	sf is_fpu
;	move.l #.fin,2(sp)	; adresse retour
;	rte

is_fpu: dc.w 0	; FF si 68881/2

   SAUT
round: moveq #0,d4
   moveq #0,d5
   move.l (a6)+,d0
   smi d7
   move.l (a6),d1
   swap d0
   move d0,d2
   and #$f,d0
   bset #4,d0
   swap d0
   moveq #0,d6
   move d2,d6
   and #$fff0,d6
   bclr #15,d2
   lsr #4,d2
   sub #$3ff,d2
   bpl.s .lb0
   moveq #0,d0
   move.l d0,(a6)
   cmp #-1,d2
   bne.s .zero
   move.l #$3ff00000,-(a6)
   tst.b d7
   beq.s .glup
   bchg #7,(a6)
.glup: rts
.zero: move.l d0,-(a6)
   rts
.lb0: cmp #52,d2
   bmi.s .lb1
   subq.l #4,a6
   rts
.lb1: moveq #-1,d7
   cmp #20,d2
   bpl.s .lb2
   moveq #0,d1
   sub #20,d2
   neg d2
   move d2,d3
   subq #1,d3
   lsl.l d2,d7
   btst d3,d0
   beq.s .lb10
   bset d3,d4
.lb10: and.l d7,d0
   bra.s .fin
.lb2: sub #52,d2
   neg d2
   lsl.l d2,d7
   move d2,d3
   subq #1,d3
   btst d3,d1
   beq.s .lb3
   bset d3,d5
.lb3: and.l d7,d1
.fin: lsl.l d5
   roxl.l d4
   add.l d5,d1
   addx.l d4,d0
   btst #21,d0
   beq.s .lb4
   lsr.l d0
   roxr.l d1
   add #$10,d6
.lb4: bclr #20,d0
   swap d6
   or.l d6,d0
   move.l d1,(a6)
   move.l d0,-(a6)
   rts

; d0/d1 un r‚el
; d2/d3 l'autre
; en sortie d0/d1 leur somme
; d0-d7 modifi‚s
; a0-a7 intacts

subplus: moveq #31,d7         ; pour acc‚der au bit de signe
   moveq #20,d6               ; pour acc‚der au bit implicite
   bclr d7,d0
   bne .n1                    ; si le premier est n‚gatif
   bclr #31,d2
   bne .p1n2                  ; 2 n‚gatif et 1 positif
.p1p2:  move.l d0,d4          ; ici les deux sont positifs
   lsr.l d6,d4                ; exposant de 1
   move.l d2,d5
   lsr.l d6,d5                ; exposant de 2
   sub.w d5,d4                ; nbr de d‚calages
   bpl.s .lb0                 ; 1 > 2
   exg.l d0,d2                ; sinon on ‚change
   exg.l d1,d3
   neg d4
.lb0: move.l d0,d5            ; conserve l'exposant du plus grand
   cmp #53,d4
   bpl .endpos                ; trop de d‚calages
   and.l #$fffff,d0           ; on ote les exposants
   and.l #$fffff,d2
   bset d6,d0                 ; on ajoute le bit implicite
   bset d6,d2
   cmp #32,d4
   bpl.s .lb1
   move.l d2,d6               ; moins de 32 d‚calages
   lsr.l d4,d2
   lsr.l d4,d3
   sub #32,d4
   neg d4
   lsl.l d4,d6
   or.l d6,d3
   bra.s .lb2
.lb1: move.l d2,d3            ; plus de 32 d‚calages, d3 inutile
   moveq #0,d2
   sub #32,d4
   lsr.l d4,d3
.lb2: add.l d3,d1             ; addition
   addx.l d2,d0
   moveq #21,d6
   btst d6,d0                 ; une retenue?
   beq.s .lb4
   add.l #$100000,d5          ; si oui on augmente l'exposant
   lsr.l d0                   ; et on d‚cale … droite
   roxr.l d1
.lb4: moveq #20,d6            ; sinon on enlŠve le bit implicite
   bclr d6,d0
   and.l #$fff00000,d5        ; on garde l'exposant seul
   or.l d5,d0                 ; qu'on ajoute … la mantisse
.endpos: rts
.n1: bclr d7,d2
   beq.s .n1p2
   bsr .p1p2                  ; meme chose si deux n‚gatifs
   bset d7,d0                 ; mais signe -
   rts
.n1p2: bset d7,d7
.p1n2: move.l d0,d4           ; l'un positif l'autre n‚gatif
   lsr.l d6,d4                ; exposant de 1
   move.l d2,d5
   lsr.l d6,d5                ; exposant de 2
   sub.w d5,d4                ; nbr de d‚calages
   bpl.s .lb5                 ; 1 > 2
   exg.l d0,d2                ; sinon on ‚change
   exg.l d1,d3
   neg d4
   bchg d7,d7
.lb5: move.l d0,d5            ; conserve l'exposant du plus grand
   cmp #53,d4
   bpl .lb12                  ; trop de d‚calages
   and.l #$fffff,d0
   and.l #$fffff,d2
   bset d6,d0
   bset d6,d2
   cmp #32,d4
   bpl.s .lb6
   move.l d2,d6
   lsr.l d4,d2
   lsr.l d4,d3
   sub #32,d4
   neg d4
   lsl.l d4,d6
   or.l d6,d3
   bra.s .lb7
.lb6: move.l d2,d3
   moveq #0,d2
   sub #32,d4
   lsr.l d4,d3
.lb7: sub.l d3,d1
   subx.l d2,d0
   bne.s .lb8
   tst.l d1
   bne.s .lb8
   rts                               ; c'est z‚ro !
.lb8: bpl.s .lb9
   neg.l d1                          ; si c'est n‚gatif, le plus grand n'‚tait
   negx.l d0                         ; pas d0/d1, on oppose
   bchg d7,d7                        ; modifie le signe du r‚sultat
.lb9: moveq #20,d6
   lsr.l d6,d5                       ; ramŠne l'exposant au bit0
   bra.s .lb11
.lb10: lsl.l d1                      ; d‚calage … gauche
   roxl.l d0
   subq.w #1,d5                      ; ajuste l'exposant
.lb11: btst d6,d0                    ; tant que le bit20 n'est pas mis
   beq.s .lb10                       ; on remonte d‚caler … gauche
   bclr d6,d0                        ; sinon on ote le bit implicite
   lsl.l d6,d5                       ; on recale l'exposant au bit20
   or.l d5,d0                        ; qu'on ajoute … d0
.lb12: tst.l d7
   bpl.s .lb13
   bset d7,d0                        ; r‚sultat n‚gatif si bit31 de d7 = 1
.lb13: rts

   SAUT
frac: move.l (a6)+,d0
   smi d7
   bclr #31,d0
   move.l (a6),d1
   move.l d0,d2
   swap d2
   lsr #4,d2
   sub #$3ff,d2
   bpl.s .lb0
   subq.l #4,a6
   rts
.lb0: cmp #52,d2
   bmi.s .lb1
.zero: moveq #0,d0
   move.l d0,(a6)
   move.l d0,-(a6)
   rts
.lb1: addq #1,d2
   cmp #32,d2
   bpl.s .lb2
   lsl.l d2,d0
   move.l d1,d3
   lsl.l d2,d1
   sub #32,d2
   neg d2
   lsr.l d2,d3
   or.l d3,d0
   bra.s .lb3
.lb2: move.l d1,d0
   moveq #0,d1
   sub #32,d2
   lsl.l d2,d0
.lb3: move #$3fe0,d2
   and.l #$001fffff,d0
   bne.s .lb4
   tst.l d1
   beq.s .zero
.lb4: bclr #20,d0
   bne.s .lb5
   sub #$10,d2
   lsl.l d1
   roxl.l d0
   bra.s .lb4
.lb5: swap d0
   or d2,d0
   swap d0
   tst.b d7
   beq.s .fin
   bset #31,d0
.fin: move.l d1,(a6)
   move.l d0,-(a6)
   rts

; d0/d1 d2/d3 les deux termes
; d0/d1 le r‚sultat
; d0-d7 tous utilis‚s.
; on d‚coupe d0/d1  en 4 fois 16 bits : d0' d0  d1' d1
; de meme pour d2/d3                  ; d2' d2  d3' d3
; on multiplie alors comme dans une op‚ration … 4 chiffres, d6/d7 servant
; d'accumulateurs qui se d‚calent … mesure que la multiplication avance
; en effet la moiti‚ des bits seront tronqu‚s et n'ont pas besoin d'etre
; conserv‚s.
; d5 sert aux multiplications interm‚diaires, d4 conserve l'exposant.
; A cause du format IEEE, d6/d7 contiennent … la fin 4 ou 5 bits de trop
; qu'on enlŠvera par d‚calages.
; le d‚but de la routine est ‚quivalente … subdiv.

submul: move.l d0,d4
   swap d4
   move d4,d7
   and.l #$7ff0,d4
   beq .zero
   move.l d2,d5
   swap d5
   move d5,d6
   and #$7ff0,d5
   beq .zero
   add d5,d4
   sub #$3ff0,d4
   swap d4
   eor d6,d7
   bpl.s .lb0
   moveq #31,d6
   bset d6,d4
.lb0: and.l #$fffff,d0
   and.l #$fffff,d2
   moveq #20,d6
   bset d6,d0
   bset d6,d2
.lb1: moveq #0,d6
   move d3,d7
   mulu d1,d7
   clr d7
   swap d7
   swap d3
   move d3,d5
   mulu d1,d5
   add.l d5,d7
   bcc.s .x1
   moveq #1,d6
.x1: swap d1
   swap d3
   move d3,d5
   mulu d1,d5
   add.l d5,d7
   bcc.s .x2
   addq #1,d6
.x2: move d6,d7
   swap d7
   moveq #0,d6
   move d0,d5
   mulu d3,d5
   add.l d5,d7
   bcc.s .x3
   moveq #1,d6
.x3: swap d3
   move d1,d5
   mulu d3,d5
   add.l d5,d7
   bcc.s .x4
   addq #1,d6
.x4: swap d1
   move d1,d5
   mulu d2,d5
   add.l d5,d7
   bcc.s .x5
   addq #1,d6
.x5: move d6,d7
   swap d7
   moveq #0,d6
   move d3,d5
   mulu d0,d5
   add.l d5,d7
   bcc.s .x6
   moveq #1,d6
.x6: swap d2
   move d1,d5
   mulu d2,d5
   add.l d5,d7
   bcc.s .x7
   addq #1,d6
.x7: swap d1
   swap d2
   move d1,d5
   mulu d2,d5
   add.l d5,d7
   bcc.s .x8
   addq #1,d6
.x8: swap d3
   swap d0
   move d0,d5
   mulu d3,d5
   add.l d5,d7
   bcc.s .x9
   addq #1,d6
.x9: swap d6
   swap d3
   mulu d0,d3
   move d2,d5
   swap d0
   mulu d0,d5
   add.l d5,d3
   bcc.s .x10
   addq #1,d6
.x10: swap d2
   mulu d2,d1
   add.l d1,d3
   bcc.s .x11
   addq #1,d6
.x11: swap d6
   swap d3
   moveq #0,d1
   move d3,d1
   clr d3
   add.l d3,d7
   addx.l d1,d6
   move d0,d5
   mulu d2,d5
   add.l d5,d6
   swap d0
   move d0,d5
   mulu d2,d5
   swap d5
   clr d5
   add.l d5,d6
   swap d2
   mulu d2,d0
   add.l d0,d6
   moveq #25,d1
   btst d1,d6
   bne.s .cinq
   moveq #24,d1
   bne.s .katr
.zero: moveq #0,d0
   moveq #0,d1
   rts
.cinq: moveq #5,d2
   moveq #27,d3
   add.l #$00100000,d4
   bra.s .suite
.katr: moveq #4,d2
   moveq #28,d3
.suite: move d6,d1
   lsl.l d3,d1
   lsr.l d2,d7
   lsr.l d2,d6
   or.l d7,d1
   moveq #20,d2
   bclr d2,d6
   move.l d6,d0
   or.l d4,d0
   rts

; d0/d1 le dividende
; d2/d3 le diviseur
; d0/d1 le quotient
; d0-d7 tous utilis‚s

subdiv: move.l d0,d4
   swap d4
   move d4,d7
   and.l #$7ff0,d4               ; l'exposant est isol‚
   beq .zero                     ; si nul c'est zero
   move.l d2,d5
   swap d5
   move d5,d6
   and #$7ff0,d5                 ; isole l'exposant de 2
   beq .infini                   ; si nul division infinie
   sub d5,d4                     ; par division on soustrait les exposants
   add #$3ff0,d4                 ; on ajoute 3ff0 pour le codage IEEE
   swap d4                       ; ramŠne l'exposant au bit20
   eor d6,d7                     ; si <0 pas de meme signe donc r‚sultat<0
   bpl.s .lb0
   moveq #31,d6
   bset d6,d4
.lb0: and.l #$fffff,d0           ; conserve les mantisses
   and.l #$fffff,d2
   moveq #20,d7
   bset d7,d0                    ; ajoute le bit implicite
   bset d7,d2
   moveq #0,d5                   ; partie haute du quotient … zero
.lb1: cmp.l d2,d0
   bmi.s .lb3
   bne.s .lb2
   cmp.l d3,d1
   bcs.s .lb3
.lb2: sub.l d3,d1                ; si divd>divs on ote et on place
   subx.l d2,d0
   bset d7,d5                    ; 1 dans le quotient
.lb3: lsl.l d1                   ; divd est ensuite d‚cal‚ ( abaisser un 0 )
   roxl.l d0
   dbf d7,.lb1                   ; on boucle 21 fois
   moveq #31,d7                  ; meme boucle mais 32 fois pour la
   moveq #0,d6                   ; partie basse du quotient ( d6 )
.lb4: cmp.l d2,d0
   bmi.s .lb6
   bne.s .lb5
   cmp.l d3,d1
   bcs.s .lb6
.lb5: sub.l d3,d1
   subx.l d2,d0
   bset d7,d6
.lb6: lsl.l d1
   roxl.l d0
   dbf d7,.lb4
   moveq #20,d7
   btst d7,d5
   bne.s .lb7
   lsl.l d6                      ; si le bit20 n'est pas mis on d‚cale …
   roxl.l d5                     ; gauche et on ajuste l'exposant
   sub.l #$00100000,d4
.lb7: bclr d7,d5                 ; ote le bit implicite
   move.l d5,d0
   or.l d4,d0
   move.l d6,d1
   rts
.zero: moveq #0,d0
   moveq #0,d1
   rts
.infini: moveq #-1,d0
   moveq #-1,d1
   rts

	SAUT
flint: move.l (a6)+,d0
   smi d3
   bclr #31,d0
   swap d0
   move d0,d2
   lsr #4,d2
   sub #$3ff,d2
   bmi.s .zero
   and #$f,d0
   bset #4,d0
   swap d0
   sub #20,d2
   bgt.s .lb0
   neg d2
   lsr.l d2,d0
   bra.s .fin
.lb0: cmp #31,d2
   bpl.s .max
   move (a6),d1
   subq #1,d2
.lb1: lsl d1
   roxl.l d0
   dbf d2,.lb1
   bra.s .fin
.zero: moveq #0,d0
   bra.s .fin
.max: move.l #$7fffffff,d0
.fin: tst.b d3
   beq.s .lb2
   neg.l d0
.lb2: move.l d0,(a6)
   rts

	SAUT
intfl: moveq #0,d1
   moveq #30,d7
   moveq #0,d2
   move.l (a6),d0
   beq.s .zero
   bpl.s .lb0
   move #$800,d2
   neg.l d0
.lb0: btst d7,d0
   dbne d7,.lb0
   moveq #0,d4
   move d7,d4
   add.w #$3ff,d4
   add.w d2,d4
   lsl.w #4,d4
   swap d4
   moveq #20,d6
   sub d6,d7
   beq.s .fin
   bmi.s .gauche
   move.l d0,d1
   lsr.l d7,d0
   sub #32,d7
   neg d7
   lsl.l d7,d1
.fin: bclr d6,d0
   or.l d4,d0
   move.l d1,(a6)
   move.l d0,-(a6)
   rts
.gauche: neg d7
   lsl.l d7,d0
   bra.s .fin
.zero: move.l d1,-(a6)
   rts

	SAUT
int: move.l (a6)+,d0
   move.l (a6),d1
   move.l d0,d2
   swap d2
   bclr #15,d2
   lsr #4,d2
   sub #$3ff,d2
   bpl.s .lb0
   moveq #0,d0
   move.l d0,(a6)
   move.l d0,-(a6)
   rts
.lb0: cmp #52,d2
   bmi.s .lb1
   subq.l #4,a6
   rts
.lb1: moveq #-1,d7
   cmp #21,d2
   bpl.s .lb2
   moveq #0,d1
   sub #20,d2
   neg d2
   lsl.l d2,d7
   and.l d7,d0
   bra.s .fin
.lb2: sub #52,d2
   neg d2
   lsl.l d2,d7
   and.l d7,d1
.fin: move.l d1,(a6)
   move.l d0,-(a6)
   rts

	SAUT
sincos:
	tst.b is_fpu
	beq.s .emul
   move #$5431,FPCMD.w
   bsr _commun_1op
   move #$7480,FPCMD.w	; pour r‚cup‚rer FP1
	bra _commun_fpn
.emul:
   bsr trigo1
   btst #0,modulo
   bne.s .lb0
   move.l a3,(a6)
   move.l a2,-(a6)
   bra.s .lb1
.lb0: move.l a1,(a6)
   move.l a0,-(a6)
.lb1: btst #1,modulo
   beq.s .lb2
   bset #7,(a6)
.lb2: tst.b signe
   beq.s .lb4
   bchg #7,(a6)
.lb4: btst #0,modulo
   beq.s .lb3
   move.l a3,-(a6)
   move.l a2,-(a6)
   btst #1,modulo
   bne.s .fin
   bset #7,(a6)
   bra.s .fin
.lb3: move.l a1,-(a6)
   move.l a0,-(a6)
   btst #1,modulo
   beq.s .fin
   bset #7,(a6)
.fin: rts

; en entr‚e d0-1 l'angle entre 0 et pi/2
; utilise a0-1 : x et cos   a2-3 : y et sin    a4-5 : z   a6 : n
; d0-d7 pour subplus
; a4-a6 sauvegard‚s.

; Algorithme :
; x=k ( constante )   y=0    z=angle   n=0
;
;          si z<0                         si z>=0
;        x'=x+y/2^n                     x'=x-y/2^n
;        y'=y-x/2^n                     y'=y+x/2^n
;        z'=z+Cn                        z'=z-Cn      ( Cn=atn(2^-n) )
;
;                      n = n + 1     et on boucle !
;  en sortie x tend vers cosinus, et y vers sinus
;  pour x<2^-26 on prend cos=1, sin=angle

trigo: movem.l a4-a6,-(sp)
   clr .boucle
   cmp.l #$3e500000,d0       ; x<2^-26
   bpl.s .lb
   move.l #$3ff00000,a0      ; cos(x)=1
   sub.l a1,a1
   move.l d0,a2              ; sin(x)=x
   move.l d1,a3
   bra .fin
.lb: move.l d0,a4
   move.l d1,a5
   sub.l a2,a2
   sub.l a3,a3
   move.l cordk,a0
   move.l cordk+4,a1
   move.l #cordic1,a6
.lb0: move.l (a6)+,d2
   move.l (a6)+,d3
   move.l a5,d1
   move.l a4,d0
   bmi .lb4
   bchg #31,d2
   bsr subplus
   move.l d0,a4
   move.l d1,a5
   move.l a2,d0
   move.l d0,d2
   smi d5
   move.l a3,d1
   move .boucle,d7
   lsl #4,d7
   swap d7
   clr d7
   sub.l d7,d2
   smi d6
   cmp.b d6,d5
   beq.s .lb1
   sub.l a2,a2
   sub.l a3,a3
   bra.s .lb2
.lb1: bchg #31,d2
   move.l d2,a2
   move.l d1,a3
.lb2: move.l a0,d2
   smi d5
   move.l a1,d3
   sub.l d7,d2
   smi d6
   cmp.b d6,d5
   bne.s .lb7
   bsr subplus
   bra.s .lb7
.lb4: bsr subplus
   move.l d0,a4
   move.l d1,a5
   move.l a2,d0
   move.l d0,d2
   smi d5
   move.l a3,d1
   move .boucle,d7
   lsl #4,d7
   swap d7
   clr d7
   sub.l d7,d2
   smi d6
   cmp.b d6,d5
   beq.s .lb5
   sub.l a2,a2
   sub.l a3,a3
   bra.s .lb6
.lb5: move.l d2,a2
   move.l d1,a3
.lb6: move.l a0,d2
   smi d5
   move.l a1,d3
   sub.l d7,d2
   smi d6
   cmp.b d6,d5
   bne.s .lb7
   bchg #31,d2
   bsr subplus
.lb7: exg.l d0,a2
   exg.l d1,a3
   move.l a0,d2
   move.l a1,d3
   bsr subplus
   move.l d0,a0
   move.l d1,a1
   addq #1,.boucle
   move dpth,d2      ; profondeur de calcul
   cmp .boucle,d2
   bne .lb0
.fin: movem.l (sp)+,a4-a6
   rts
.boucle: dc.w 0

; en entr‚e : l'angle sur la pile

trigo1: clr.b modulo        ; 0, 1, 2 ou 3 fois pi/2
   move.l (a6)+,d0
   smi signe
   bclr #31,d0
   move.l (a6),d1
   move.l #pisur2,a0
   move.l (a0)+,d2
   move.l (a0),d3
   bsr subdiv             ; calcule x/(pi/2)
   swap d0
   move d0,d2
   and #$f,d0
   bset #4,d0
   swap d0
   lsr #4,d2
   sub #$3ff,d2
   bpl.s .lb0
   move.l -4(a6),d0       ; si n‚gatif alors, x<pi/2
   move.l (a6),d1
   bclr #31,d0
   bra .suite
.lb0: cmp #51,d2
   bpl .trop
.lb1: lsl.l d1
   roxl.l d0
   dbf d2,.lb1
   btst #21,d0
   beq.s .lb2
   addq.b #1,modulo
.lb2: btst #22,d0
   beq.s .lb3
   addq.b #2,modulo
.lb3: and.l #$001fffff,d0
   bne.s .lb4
   tst.l d1
   beq.s .lb6
   moveq #20,d7
.lb4: bclr d7,d0
   bne.s .lb5
   lsl.l d1
   roxl.l d0
   subq #1,d2
   bra.s .lb4
.lb5: add #$3ff,d2
   lsl #4,d2
   bclr #16,d2
   swap d2
   clr d2
   add.l d2,d0
.lb6: move.l (a0),d3
   move.l -(a0),d2
   bsr submul
.suite: bsr trigo
   rts
.trop: subq.l #4,a6
   rts

	SAUT
sin: tst.b is_fpu
   beq.s .emul
   move #$540E,FPCMD.w
   bra _commun_1op
.emul:
   bsr trigo1
   btst #0,modulo
   bne.s .lb0
   move.l a3,(a6)
   move.l a2,-(a6)
   bra.s .lb1
.lb0: move.l a1,(a6)
   move.l a0,-(a6)
.lb1: btst #1,modulo
   beq.s .lb2
   bset #7,(a6)
.lb2: tst.b signe
   beq.s .fin
   bchg #7,(a6)
.fin: rts

	SAUT
cos: tst.b is_fpu
   beq.s .emul
   move #$541D,FPCMD.w
   bra _commun_1op
.emul:
   bsr trigo1
   btst #0,modulo
   beq.s .lb0
   move.l a3,(a6)
   move.l a2,-(a6)
   btst #1,modulo
   bne.s .fin
   bset #7,(a6)
   bra.s .fin
.lb0: move.l a1,(a6)
   move.l a0,-(a6)
   btst #1,modulo
   beq.s .fin
   bset #7,(a6)
.fin: rts

	SAUT
tan: tst.b is_fpu
   beq.s .emul
   move #$540F,FPCMD.w
   bra _commun_1op
.emul:
   bsr trigo1
   btst #0,modulo
   beq.s .lb0
   move.l a0,d0
   move.l a1,d1
   move.l a2,d2
   move.l a3,d3
   bset #31,d0
   bra.s .suite
.lb0: move.l a2,d0
   move.l a3,d1
   move.l a0,d2
   move.l a1,d3
.suite: bsr subdiv
   tst.b signe
   beq.s .fin
   bchg #31,d0
.fin: move.l d1,(a6)
   move.l d0,-(a6)
   rts

   SAUT
asin:
   tst.b _fpu
   beq.s .emul
   move #$540C,FPCMD.w
   bra _commun_1op
.emul:
   bsr.s _asin_acos
_asin_comm:
   bsr fplus			; 1+sqr(1-x^2)
   				; ou 1+x
   bsr fdiv			; x / (1+sqr(1-x^2))
   				; ou sqr(1-x^2)/(1+x)
   bsr atn
   moveq #1,d0
   move.l d0,-(a6)
   bsr ffois2			; 2* atn ( x / (1+sqr(1-x^2) ) = asin(x) !!
   				; ou 2 * atn (sqr(1-x^2)/(1+x)) = acos(x)
   rts

_asin_acos:
   movem.l (a6),d0-d1		; x
   clr.l -(a6)
   move.l #$3FF00000,-(a6)	; 1
   clr.l -(a6)
   move.l #$3FF00000,-(a6)	; 1
   clr.l -(a6)
   move.l d1,-(a6)
   move.l d0,-(a6)		; x
   move.l d1,-(a6)
   move.l d0,-(a6)   		; x
   bsr ffois			; x^2
   bsr fmoins			; 1-x^2
   bsr sqr			; sqr(1-x^2)
   rts

   SAUT
acos:
   tst.b _fpu
   beq.s .emul
   move #$541C,FPCMD.w
   bra _commun_1op
.emul:
   cmp.l #$BFF00000,(a6)	; est-ce -1?
   bne.s .normal
   tst.l 4(a6)
   bne.s .normal
   lea pi+4,a0			; si c'est -1, renvoyer PI
   move.l (a0),-(a6)
   move.l -(a0),-(a6)
   rts
.normal:
   bsr.s _asin_acos		; sinon, formule !
   bsr frot
   bra _asin_comm


; Algorithme :
; x=1   y=angle    z=0   n=0
;
;          si y>=0                         si y<0
;        x'=x+y/2^n                     x'=x-y/2^n
;        y'=y-x/2^n                     y'=y+x/2^n
;        z'=z+Cn                        z'=z-Cn      ( Cn=atn(2^-n) )
;
;                      n = n + 1     et on boucle !
;  en sortie z tend vers atn
;  pour x<2^-26 on prend atn(x)=x

   SAUT
atn: tst.b is_fpu
   beq.s _emul2
   move #$540A,FPCMD.w
_commun_1op:
   lea FPOP.w,a0
   tst.w FPCIR.w
   move.l (a6)+,(a0)
   move.l (a6)+,(a0)
   move #$7400,FPCMD.w
_commun_fpn:
   subq.l #8,a6
.wait: move FPCIR-FPOP(a0),d0
   cmp #$8900,d0
   beq.s .wait
   move.l (a0),(a6)
   move.l (a0),4(a6)
   rts
_emul2:
   movem.l a4-a6,-(sp)
   clr .boucle
   move.l (a6)+,d0
   smi signe
   bclr #31,d0
   move.l d0,a2
   move.l (a6),a3
   cmp.l #$3e500000,a2       ; x<2^-26
   bpl.s .lb
   movem.l (sp)+,a4-a6       ; atn(x)=x
   rts
.lb: sub.l a4,a4
   sub.l a5,a5
   move.l #cordic1,a6
   move.l #$3ff00000,a0
   sub.l a1,a1
.lb0: move.l (a6)+,d2
   move.l (a6)+,d3
   move.l a5,d1
   move.l a4,d0
   cmp.l #0,a2
   bpl .lb4
   bchg #31,d2
   bsr subplus
   move.l d0,a4
   move.l d1,a5
   move.l a2,d0
   move.l d0,d2
   smi d5
   move.l a3,d1
   move .boucle,d7
   lsl #4,d7
   swap d7
   clr d7
   sub.l d7,d2
   smi d6
   cmp.b d6,d5
   beq.s .lb1
   sub.l a2,a2
   sub.l a3,a3
   bra.s .lb2
.lb1: bchg #31,d2
   move.l d2,a2
   move.l d1,a3
.lb2: move.l a0,d2
   smi d5
   move.l a1,d3
   sub.l d7,d2
   smi d6
   cmp.b d6,d5
   bne.s .lb7
   bsr subplus
   bra.s .lb7
.lb4: bsr subplus
   move.l d0,a4
   move.l d1,a5
   move.l a2,d0
   move.l d0,d2
   smi d5
   move.l a3,d1
   move .boucle,d7
   lsl #4,d7
   swap d7
   clr d7
   sub.l d7,d2
   smi d6
   cmp.b d6,d5
   beq.s .lb5
   sub.l a2,a2
   sub.l a3,a3
   bra.s .lb6
.lb5: move.l d2,a2
   move.l d1,a3
.lb6: move.l a0,d2
   smi d5
   move.l a1,d3
   sub.l d7,d2
   smi d6
   cmp.b d6,d5
   bne.s .lb7
   bchg #31,d2
   bsr subplus
.lb7: exg.l d0,a2
   exg.l d1,a3
   move.l a0,d2
   move.l a1,d3
   bsr subplus
   move.l d0,a0
   move.l d1,a1
   addq #1,.boucle
   move dpth,d0
   cmp .boucle,d0
   bne .lb0
   move.l a4,d0
   move.l a5,d1
   movem.l (sp)+,a4-a6
   tst.b signe
   beq.s .fin
   bset #31,d0
.fin: move.l d0,(a6)
   move.l d1,4(a6)
   rts
.boucle: dc.w 0

	SAUT
carre: tst.b is_fpu
   beq.s .emul
   lea FPOP.w,a0
   move #$5400,FPCMD-FPOP(a0)
   tst.w FPCIR-FPOP(a0)
   move.l (a6)+,(a0)
   move.l (a6),(a0)
   move #$0023,FPCMD-FPOP(a0)	; fmul fp0,fp0
   tst.w FPCIR-FPOP(a0)
   move #$7400,FPCMD-FPOP(a0)
   subq.l #4,a6
.wait: move FPCIR-FPOP(a0),d0
   cmp #$8900,d0
   beq.s .wait
   move.l (a0),(a6)
   move.l (a0),4(a6)
   rts
.emul:
   move.l (a6)+,d0
   move.l (a6),d1
   move.l d0,d2
   move.l d1,d3
   bsr submul
   move.l d1,(a6)
   move.l d0,-(a6)
   rts

; algorithme : X=m*2^n. On sait calculer l'exponentielle d'une valeur
; inf‚rieure … 1. Si X<2^-26 on utilise un DL : exp(X)=1+X
;                 Si X<1     alors x=X      et e=0
;                 Si X>1     alors x=m*2^-1 et e=n+1
; Pour calculer l'exponentielle de x:
;    on d‚compose x en une somme de Ci, avec Ci=ln(1+2^-i)
;    ensuite exp(x)= produit de (1+2^-i), ce qui se fait par d‚calages et somme
; Pour calculer ensuite exp(X) :
;    exp(X)=exp(x)^(2^e), c'est … dire au carr‚ e fois.
; ( Note : si X ‚tait n‚gatif, on calcule ensuite 1/exp(X) )
	SAUT
expo: tst.b is_fpu
   beq.s .emul
   move #$5410,FPCMD.w
   bra _commun_1op
.emul:
   moveq #0,d3
   move.l #$00100000,d2      ; d2-d3 est l'exponentielle, au d‚but 1.
   move.l (a6)+,d0
   smi signe
   bclr #31,d0
   cmp.l #$408633ce,d0
   bmi.s .lb
   move.l #$7fffffff,d0
   moveq #0,d1
   bra .sortie
.lb: cmp.l #$3e500000,d0
   bpl.s .lb0
   subq.l #4,a6          ; si x<2^-26 alors
   move.l d3,-(a6)     ; exp(x)=1+x
   move.l #$3ff00000,-(a6)
   bra fplus
.lb0: move.l (a6),d1
   swap d0
   move d0,d4
   and #$f,d0
   bset #4,d0
   swap d0               ; d0 ne contient plus que la mantisse
   lsr #4,d4
   sub #$3ff,d4          ; d4 est l'exposant
   bmi.s .lb1            ; si n‚gatif exp est direct
   addq #1,d4            ; sinon m*2^n est calcul‚ avec m*2^-1 d'abord
   swap d4               ; puis par mise au carr‚ on tient compte de 2^(n+1)
   move #-1,d4
   bra.s .lb2
.lb1: swap d4
   clr d4
   swap d4
.lb2: neg d4             ; ici d4 contient [n+1 ou 0].w pour les mises au carr‚
   move.l #logexp,a0     ;                 [ e ].w      exposant de la mantisse
.lb3: cmp dpthex,d4      ; a t-on fini?
   bpl .fin
   move d4,d6
   asl #3,d6
   move d4,d5
   lea -8(a0,d6),a1      ; a1 pointe sur la donn‚e ayant le meme expos que x
   move.l (a1)+,d6
   move.l (a1)+,d7
   sub.l d7,d1
   subx.l d6,d0          ; calcule x-Ci
   bpl.s .lb4            ; positif, c'est bon
   add.l d7,d1
   addx.l d6,d0          ; sinon restaure x
   addq #1,d5            ; prend Ci+1, un eposant en dessous
   move.l (a1)+,d6
   move.l (a1),d7
   lsr.l d6              ; d‚calage oblig‚
   roxr.l d7
   sub.l d7,d1
   subx.l d6,d0          ; calcule le nouveau x-Ci
.lb4: bne.s .lb6         ; si le r‚sulat est nul
   tst.l d1
   beq .lb5              ; on saute
.lb6: btst #20,d0        ; sinon on v‚rifie que x contient toujours le bit 20
   bne.s .lb5
   addq #1,d4            ; cas contraire on d‚cale d'une position
   lsl.l d1
   roxl.l d0
   bra.s .lb6            ; nouvelle v‚rification
.lb5: move d5,d6
   swap d5
   move d6,d5            ; d5 contient deux fois l'exposant de x
   move.l d2,d6
   move.l d3,d7          ; dans d6-d7 on calcule d2-d3 / 2^i
   subq #1,d5
   beq.s .lb8
   cmp #32,d5
   bpl.s .lb7
   move.l d0,a1               ; moins de 32 d‚calages
   move.l d6,d0
   lsr.l d5,d6
   lsr.l d5,d7
   sub #32,d5
   neg d5
   lsl.l d5,d0
   or.l d0,d7
   move.l a1,d0
   bra.s .lb8
.lb7: move.l d6,d7            ; plus de 32 d‚calages, d7 inutile
   moveq #0,d6
   sub #32,d5
   lsr.l d5,d7
.lb8: swap d5
   add.l d7,d3
   addx.l d6,d2               ; d2-d3 = d2-d3 *(1+2^-i)
   move.l d0,d7
   or.l d1,d7                 ; si la mantisse est nulle
   bne .lb3                   ; on ne reviendra pas en arriŠre
.fin: swap d4
   move.l #$3ff00000,d6       ; exposant normal, si e^x < 2
   btst #21,d2                ; si e^x d‚passe 2, bit 21 mis
   beq.s .lb10
   move.l #$40000000,d6       ; alors 1 pour exposant
   lsr.l d2                   ; et on d‚cale
   roxr.l d3
.lb10: bclr #20,d2            ; ote le bit implicite
   or.l d6,d2                 ; ajoute l'exposant
   move.l d2,d0
   move.l d3,d1               ; colle le tout dans d0-d1
   move d4,a0
.lb9: cmp #0,a0               ; eposant de d‚part nul?
   beq.s .sortie              ; si oui pas de mise au carr‚
   subq #1,a0                 ; sinon
   move.l d0,d2
   move.l d1,d3
   bsr submul                 ; au carr‚
   bra.s .lb9                 ; on boucle
.sortie: tst.b signe          ; signe moins?
   beq.s .out
   move.l d0,d2
   move.l d1,d3
   move.l #$3ff00000,d0
   moveq #0,d1
   bsr subdiv                 ; si oui alors exp(-x)=1/exp(x)
.out: move.l d1,(a6)          ; ouf...
   move.l d0,-(a6)
   rts

; algorithme : X=m*2^e
; donc ln(X)= ln(m) + e * ln(2)
; pour le calcul de ln(m) :
;   on ‚crit m sous la forme d'un produit de (1+2^-i)
;   puis ln(m) = somme ( ln(1+2^-i) ), valeurs en m‚moire.
; [ plutot que de diviser m par 1+2^-i ( ce qui est long )
; on part de k=1, puis on calcule k'=k*(1+2^-i) ( par d‚calage et somme )
; ceci tant qu'on ne d‚passe pas m. ]
; [ si X<0, on prend la valeur absolue
;   si m<1+2^-26, on utilise un DL ln(1+x)=x-x^2/2 ]

	SAUT
loga: tst.b is_fpu
   beq.s .emul
   move #$5414,FPCMD.w
   bra _commun_1op
.emul:
   move.l (a6)+,d0
   bclr #31,d0
   move.l (a6),d1             ; d0-d1 = abs(x)
   swap d0
   moveq #0,d2
   move d0,d2
   and #$f,d0
   bset #4,d0
   swap d0                    ; d0 ne contient plus que la mantisse
   lsr #4,d2
   bne.s .lb0
   moveq #-1,d0               ; si x=0
   move.l d0,(a6)             ; ln(x)= -infini
   move.l d0,-(a6)
   rts
.lb0: move.l #logexp+8,a1     ; pointe sur ln(1.5)
   sub.l a0,a0
   sub #$3ff,d2               ; d2 est l'exposant
   bne.s .lb1
   moveq #0,d2                ; si l'exp est nul, la partie e*ln(2)
   move.l d2,(a6)             ; est nulle aussi
   move.l d2,-(a6)
   bra.s .lb5
.lb1: bpl.s .lb2
   move #1,a0                 ; a0=1 si l'exp est n‚gatif
   neg d2
.lb2: movem.l d0-d1,-(sp)     ; sauve d0-d1
   moveq #10,d5
.lb3: bclr d5,d2              ; convertit e ( entre 1 et 1024 ) en r‚el
   dbne d5,.lb3
   moveq #0,d3
   moveq #20,d6
   sub d5,d6
   lsl.l d6,d2
   add #$3ff,d5
   lsl #4,d5
   swap d5
   or.l d5,d2                 ; dans d2-d3
   move.l #$3fe62e42,d0       ; ln(2) dans d0-d1
   move.l #-$105c611,d1
   cmp #0,a0
   beq.s .lb4
   bset #31,d0                ; ajuste le signe
.lb4: bsr submul
   move.l d1,(a6)
   move.l d0,-(a6)            ; conserve e*ln(2) sur la pile
   movem.l (sp)+,d0-d1        ; r‚cupŠre d0-d1
.lb5: move.l d0,a2            ; a2-a3 est la mantisse
   move.l d1,a3
   moveq #1,d6                ; nombre de d‚calages ( 1 pour 1.5 )
   moveq #0,d2
   moveq #0,d3
   moveq #0,d1                ; d0-d1 est l'accumulateur 0 au d‚part
   moveq #0,d0
   bset #20,d2                ; d2-d3 est l'approche de la mantisse, 1 au d‚part
.lb6: move.l d2,d4
   move.l d3,d5               ; d4-d5 va etre d2-d3/2^i
   move d6,a0
   cmp #32,d6
   bpl.s .lb7
   move.l d4,d7               ; moins de 32 d‚calages
   lsr.l d6,d4
   lsr.l d6,d5
   sub #32,d6
   neg d6
   lsl.l d6,d7
   or.l d7,d5
   bra.s .lb8
.lb7: move.l d4,d5            ; plus de 32 d‚calages, d5 inutile
   moveq #0,d4
   sub #32,d6
   lsr.l d6,d5
.lb8: move a0,d6
   add.l d3,d5                ; d4-d5= d2-d3+d4-d5, donc d4-d5=d2-d3*(1+2^-i)
   addx.l d2,d4
   cmp.l a2,d4
   bmi.s .ok                  ; ne d‚passe pas la mantisse, ok
   bne.s .autre               ; sinon au suivant
   cmp.l a3,d5                ; meme chose si ‚galit‚ des 21 bits sup‚rieurs
   beq.s .ok
   bcc.s .autre
.ok: move.l d4,d2             ; d2-d3 devient d4-d5
   move.l d5,d3
   tst.l d0
   bne.s .lb9
   move.l (a1)+,d0            ; si d0=0, premier calcul
   move.l (a1)+,d1
   move d6,d7
   swap d6
   move d7,d6                 ; on initialise d6.w (fort)
   swap d6
   bra.s .suite
.lb9: move.l (a1)+,d4         ; sinon on ajoute … d0-d1 ln(1+2^-i)
   move.l (a1)+,d5
   move.l d6,a0
   swap d6
   sub a0,d6
   neg d6                     ; pour cela il faut d‚caler !
   cmp #32,d6
   bpl.s .lb10
   move.l d4,d7               ; moins de 32 d‚calages
   lsr.l d6,d4
   lsr.l d6,d5
   sub #32,d6
   neg d6
   lsl.l d6,d7
   or.l d7,d5
   bra.s .lb11
.lb10: move.l d4,d5            ; plus de 32 d‚calages, d5 inutile
   moveq #0,d4
   sub #32,d6
   lsr.l d6,d5
.lb11: move.l a0,d6
   add.l d5,d1
   addx.l d4,d0                ; mise … jour de l'accumulateur
   btst #21,d0
   beq.s .suite
   lsr.l d0                    ; d‚passe 2, on ajuste
   roxr.l d1
   sub.l #$10000,d6            ; l'exposant aussi
   bra.s .suite
.autre: addq.l #8,a1           ; si pas ok, on passe … i+1
.suite: addq #1,d6
   cmp dpthln,d6               ; a t-on fini?
   bne .lb6
   tst.l d0                    ; si accu nul, alors e*ln(2) suffit
   beq.s .fin
   swap d6                     ; sinon on reforme l'accu avec son exposant
   moveq #-1,d7
   sub d6,d7
   add #$3ff,d7
   lsl #4,d7
   swap d7
   clr d7
   bclr #20,d0
   or.l d7,d0
   move.l (a6)+,d2
   move.l (a6),d3             ; r‚cupŠre e*ln(2)
   bsr subplus                ; additionne ln(m) avec e*ln(2)
   move.l d1,(a6)             ; c'est fini...
   move.l d0,-(a6)
.fin: rts

; sqr(A) utilise l'algorithme de newton appliqu‚ … f(x)=x^2-A
; ce qui donne : x'=(x+A/x)/2, qui est ex‚cut‚ 6 fois avec pour valeur
; de d‚part ( A = m * 2^e ) x = m * 2^(e/2), ce qui assure une erreur
; de d‚part d'un facteur racine de 2 au plus !

	SAUT
sqr:
   bclr #7,(a6)                 ; signe non pris en compte
   tst.b is_fpu
   beq.s .emul
   move #$5404,FPCMD.w
   bra _commun_1op
.emul:
   lea .boucle(pc),a1         ; zone servant de compteur de boucle
   move #6,(a1)                 ; 6 boucles
   move.l a6,a0                 ; on recopie A dans la pile un cran en dessous
   move.l 4(a6),d1              ; A est en plus dans D0/D1
   move.l d1,-(a0)
   move.l (a6),d0
   swap d0
   move d0,d2
   and #$7ff0,d2
   beq .zero
   sub #$3ff0,d2
   asr d2                       ; pour le x de d‚part on divise l'exposant
   add #$3ff0,d2                ; par 2.
   and #$7ff0,d2
   and #$f,d0
   or d2,d0
   swap d0
   move.l d0,-4(a0)
.lb0: move.l d0,d2              ; copie x dans d2/d3
   move.l d1,d3
   move.l (a6),d0               ; A dans d0/d1
   move.l 4(a6),d1
   bsr subdiv                   ; A/x
   move.l (a0),d3               ; x dans d2/d3
   move.l -(a0),d2
   bsr subplus                  ; x+A/x
   sub.l #$00100000,d0          ; (x+A/x)/2
   move.l d0,(a0)+              ; copie le nouveau x dans la pile
   move.l d1,(a0)
   subq #1,(a1)                 ; boucle finie?
   bne.s .lb0
   move.l d0,(a6)               ; si oui d0/d1 sur la pile
   move.l d1,4(a6)
   rts
.boucle: dc.w 0
.zero: clr.l (a6)
   clr.l 4(a6)
   rts

	SAUT
fdiv: tst.b is_fpu
   beq.s .emul
   move #$5420,d0	; code f/
   bra.s _commun_2op
.emul:
   move.l (a6)+,d2
   move.l (a6)+,d3
   move.l (a6)+,d0
   move.l (a6),d1
   bsr subdiv
   move.l d1,(a6)
   move.l d0,-(a6)
   rts

	SAUT
ffois: tst.b is_fpu
   beq.s .emul
   move #$5423,d0	; code f*
   bra.s _commun_2op
.emul:
   move.l (a6)+,d0
   move.l (a6)+,d1
   move.l (a6)+,d2
   move.l (a6),d3
   bsr submul
   move.l d1,(a6)
   move.l d0,-(a6)
   rts

	SAUT
fplus: tst.b is_fpu
   beq.s _emul
   move #$5422,d0	; code f+
_commun_2op:
   lea FPOP.w,a0
   move #$5400,FPCMD-FPOP(a0)
   lea 8(a6),a1
   tst.w FPCIR-FPOP(a0)
   move.l (a1)+,(a0)
   move.l (a1),(a0)
   move d0,FPCMD-FPOP(a0)
   tst.w FPCIR-FPOP(a0)
   move.l (a6)+,(a0)
   move.l (a6)+,(a0)
   move #$7400,FPCMD-FPOP(a0)
.wait: move FPCIR-FPOP(a0),d0
   cmp #$8900,d0
   beq.s .wait
   move.l (a0),(a6)
   move.l (a0),4(a6)
   rts
_emul:
   move.l (a6)+,d0
   move.l (a6)+,d1
   move.l (a6)+,d2
   move.l (a6),d3
   bsr subplus
   move.l d1,(a6)
   move.l d0,-(a6)
   rts

	SAUT
fmoins: tst.b is_fpu
   beq.s .emul
   move #$5428,d0	; code f-
   bra.s _commun_2op
.emul:
   move.l (a6)+,d0
   moveq #31,d7
   bchg d7,d0
   move.l (a6)+,d1
   move.l (a6)+,d2
   move.l (a6),d3
   bsr subplus
   move.l d1,(a6)
   move.l d0,-(a6)
   rts

	SAUT
inv: tst.b is_fpu
   beq.s .emul
   move #$5C32,FPCMD.w	; fmovecr #50,fp0 (1.0 dans fp0)
   tst FPCIR.w
   move #$5420,FPCMD.w	; fdiv
   bra _commun_1op
.emul:
   move.l #$3ff00000,d0
   moveq #0,d1
   move.l (a6)+,d2
   move.l (a6),d3
   bsr subdiv
   move.l d1,(a6)
   move.l d0,-(a6)
   rts

; pour logarithme et exponentielle
; log(1+2^-n) n partant de 0.
; seule la mantisse est pr‚sente ( le bit implicite est mis )
; les exposants commencent … -1 puis descendent de 1 en 1.

logexp:

   dc.l $162E42,-$105C611		; ln (2)
   dc.l $19F323,-$134067B4		; ln (1.5)
   dc.l $1C8FF7,-$386565DE		; ln (1.25)
   dc.l $1E2707,$6E2AF2E6
   dc.l $1F0A30,-$3FEE9D5A
   dc.l $1F829B,$E783300
   dc.l $1FC0A8,-$4F03FC1C
   dc.l $1FE02A,$6B106789
   dc.l $1FF00A,-$5D4EF440
   dc.l $1FF802,-$5654EF1A
   dc.l $1FFC00,-$55754EF0
   dc.l $1FFE00,$2AA6AB11
   dc.l $1FFF00,$AAA2AB1
   dc.l $1FFF80,$2AA9AAB
   dc.l $1FFFC0,$AAA8AB
   dc.l $1FFFE0,$2AAA6B
   dc.l $1FFFF0,$AAAA3
   dc.l $1FFFF8,$2AAAA
   dc.l $1FFFFC,$AAAB
   dc.l $1FFFFE,$2AAB
   dc.l $1FFFFF,$AAB
   dc.l $1FFFFF,-$7FFFFD55
   dc.l $1FFFFF,-$3FFFFF55
   dc.l $1FFFFF,-$1FFFFFD5
   dc.l $1FFFFF,-$FFFFFF5
   dc.l $1FFFFF,-$7FFFFFD
   dc.l $1FFFFF,-$3FFFFFF
   dc.l $1FFFFF,-$2000000
   dc.l $1FFFFF,-$1000000
   dc.l $1FFFFF,-$800000
   dc.l $1FFFFF,-$400000
   dc.l $1FFFFF,-$200000
   dc.l $1FFFFF,-$100000
   dc.l $1FFFFF,-$80000
   dc.l $1FFFFF,-$40000
   dc.l $1FFFFF,-$20000
   dc.l $1FFFFF,-$10000
   dc.l $1FFFFF,-$8000
   dc.l $1FFFFF,-$4000
   dc.l $1FFFFF,-$2000
   dc.l $1FFFFF,-$1000
   dc.l $1FFFFF,-$800
   dc.l $1FFFFF,-$400
   dc.l $1FFFFF,-$200
   dc.l $1FFFFF,-$100
   dc.l $1FFFFF,-$80
   dc.l $1FFFFF,-$40
   dc.l $1FFFFF,-$20
   dc.l $1FFFFF,-$10
   dc.l $1FFFFF,-$8
   dc.l $1FFFFF,-$4
   dc.l $1FFFFF,-$2
   dc.l $1FFFFF,-$1			; ln (1+2^-52)

; donn‚es pour les fonctions trigo
; chaque ligne repr‚sente atn(2^-n), en commen‡ant avec n=0.

cordic1:
   dc.l $3FE921FB,$54442D18
   dc.l $3FDDAC67,$561BB4F
   dc.l $3FCF5B75,-$6D37F23
   dc.l $3FBFD5BA,-$6553D092
   dc.l $3FAFF55B,-$48D30216
   dc.l $3F9FFD55,-$445689DB
   dc.l $3F8FFF55,$5BBB729B
   dc.l $3F7FFFD5,$55BBBA97
   dc.l $3F6FFFF5,$555BBBB7
   dc.l $3F5FFFFD,$5555BBBC
   dc.l $3F4FFFFF,$55555BBC
   dc.l $3F3FFFFF,-$2AAAAA44
   dc.l $3F2FFFFF,-$AAAAAA4
   dc.l $3F1FFFFF,-$2AAAAAA
   dc.l $3F0FFFFF,-$AAAAAB
   dc.l $3EFFFFFF,-$2AAAAB
   dc.l $3EEFFFFF,-$AAAAB
   dc.l $3EDFFFFF,-$2AAAB
   dc.l $3ECFFFFF,-$AAAB
   dc.l $3EBFFFFF,-$2AAB
   dc.l $3EAFFFFF,-$AAB
   dc.l $3E9FFFFF,-$2AB
   dc.l $3E8FFFFF,-$AB
   dc.l $3E7FFFFF,-$2B
   dc.l $3E6FFFFF,-$B
   dc.l $3E5FFFFF,-$3
   dc.l $3E4FFFFF,-$1
   dc.l $3E400000,$0
   dc.l $3E300000,$0
   dc.l $3E200000,$0
   dc.l $3E100000,$0
   dc.l $3E000000,$0
   dc.l $3DF00000,$0
   dc.l $3DE00000,$0
   dc.l $3DD00000,$0
   dc.l $3DC00000,$0
   dc.l $3DB00000,$0
   dc.l $3DA00000,$0
   dc.l $3D900000,$0
   dc.l $3D800000,$0
   dc.l $3D700000,$0
   dc.l $3D600000,$0
   dc.l $3D500000,$0
   dc.l $3D400000,$0
   dc.l $3D300000,$0
   dc.l $3D200000,$0
   dc.l $3D100000,$0
   dc.l $3D000000,$0
   dc.l $3CF00000,$0
   dc.l $3CE00000,$0
   dc.l $3CD00000,$0
   dc.l $3CC00000,$0
   dc.l $3CB00000,$0

   SAUT
cosh: tst.b is_fpu
   beq.s .emul
   move #$5419,FPCMD.w
	bra _commun_1op
.emul:
	bsr expo
	move #$3FF0,d0
_cosh_sinh:
	movem.l (a6),d1-d2	; exp(x)
	clr.l -(a6)
	clr.w -(a6)
	move d0,-(a6)	; 1 ou -1
	move.l d2,-(a6)
	move.l d1,-(a6)
	bsr fdiv			; +/1 exp(-x)
	bsr fplus		; e(x) +/- e(-x)
	moveq #-1,d0
	move.l d0,-(a6)
	bsr ffois2		; (  e(x) +/- e(-x) )/2
	rts

	SAUT
sinh: tst.b is_fpu
   beq.s .emul
   move #$5402,FPCMD.w
	bra _commun_1op
.emul:
	bsr expo
	move #$BFF0,d0
	bra.s _cosh_sinh

	SAUT
tanh: tst.b is_fpu
   beq.s .emul
   move #$5409,FPCMD.w
	bra _commun_1op
.emul:
	moveq #1,d0
	move.l d0,-(a6)
	bsr ffois2			; 2x
	bsr expo
	clr.l -(a6)
	move.l #$3FF00000,-(a6)
	bsr fmoins			; e(2x)-1
	bsr fdup
	clr.l -(a6)
	move.l #$40000000,-(a6)
	bsr fplus			; e(2x)+1
	bsr fdiv
	rts

	SAUT
asinh:
	move #$3FF0,d0		; pour 1
_asinh_acosh:
	movem.l (a6),d1-d2
	clr.l -(a6)
	clr -(a6)
	move d0,-(a6)		; +/-1
	move.l d2,-(a6)
	move.l d1,-(a6)	; x
	move.l d2,-(a6)
	move.l d1,-(a6)	; x
	bsr ffois			; x^2
	bsr fplus			; x^2+/-1
	bsr sqr
	bsr fplus			; x+sqr(x^2+/-1)
	bsr loga
	rts

	SAUT
acosh:
	move #$BFF0,d0			; pour -1
	bra.s _asinh_acosh

	SAUT
atanh: tst.b is_fpu
   beq.s .emul
   move #$540d,FPCMD.w
	bra _commun_1op
.emul:
	clr.l -(a6)
	move.l #$3ff00000,-(a6)	; 1
	bsr fplus					; x+1
	bsr fdup
	bchg #7,(a6)				; -1-x
	clr.l -(a6)
	move.l #$40000000,-(a6)	; 2
	bsr fplus					; 1-x
	bsr fdiv						; x+1 / 1-x
	bsr loga
	moveq #-1,d0
	move.l d0,-(a6)
	bsr ffois2					; 1/2 log ( x+1 / 1-x )
	rts

	SAUT
lambert1:
	tst.b (a6)			; valeur a n‚gative?
	smi d2				; flag pour lambert 1, FF si a<0 pour branche secondaire
							; sinon 00 et lambert normal
	bra.s _lamb_com

	SAUT
lambert:
	sf d2					; flag pour lambert 0
_lamb_com:
	tst.b is_fpu
	beq .emul
	moveq #12,d0		; 13 it‚rations semble bien fonctionner
	lea .data(pc),a0
	move (a0)+,FPCMD.W
   lea FPOP.w,a1
   tst.w FPCIR.w
   move.l (a6)+,(a1)
   move.l (a6)+,(a1)
   tst.b d2
   bne.s .operations		; pour lambert1, continue en s‚quence
   lea .lamb0(pc),a0		; sinon saute au log(x+1)
   bra.s .operations
.reset:
	lea .data_loop(pc),a0
.operations:
	move (a0)+,d1
	bmi.s .reset			; -1 pour lambert1, passe … la boucle
	beq.s .fin				; 0 fin
	move d1,FPCMD.W
.wait:
	move FPCIR.w,d1
	cmp #$8900,d1
	beq.s .wait
	bra.s .operations
.fin:
	move #1,FPCCR.w			; condition EQ
.wait3:
	move FPCIR.w,d1
	bmi.s .wait3
	btst #0,d1					; flag "true"
	bne.s .found				; x' = x, pas de changement, on quitte
	dbf d0,.reset
.found:
	move (a0)+,FPCMD.w
	subq.l #8,a6
.wait2:
	move FPCIR.w,d1
	cmp #$8900,d1
	beq.s .wait2
	move.l (a1),(a6)
	move.l (a1),4(a6)
	rts
.data:
	dc.w $5600	;	fmove.d (a6)+,fp4	; "a" de x*exp(x) = a
	dc.w $1018	;	fabs fp4,fp0
	dc.w $0014	;	flogn fp0		; valeur initiale ln(-x) pour branche secondaire
	dc.w -1
.lamb0:
	dc.w $1006	;	flognp1 fp4,fp0	; valeur initiale log(a+1) pour branche principale
.data_loop:
	dc.w $0280	;		fmove fp0,fp5		; sauf pour comparaison
	dc.w $0090	;		fetox fp0,fp1		; fp1=e(x)
	dc.w $0500	;		fmove fp1,fp2
	dc.w $0123	;		fmul fp0,fp2		; fp2=x*e(x)
	dc.w $0980	;		fmove fp2,fp3
	dc.w $05a2	;		fadd fp1,fp3		; fp3=x*e(x)+e(x) = d‚riv‚e de la fonction
	dc.w $1128	;		fsub fp4,fp2		; fp2 = x*e(x)-a = valeur de la fonction
	dc.w $0d20	;		fdiv fp3,fp2		; epsilon
	dc.w $0828	;		fsub fp2,fp0		; x'=x-epsilon, nouvelle valeur
	dc.w $02b8	;		fcmp fp0,fp5		; un changement ?
	dc.w 0
	dc.w $7400	;		fmove.d fp0,-(a6)

.emul:				; ici Lambert en ‚mulation
	move.l 4(a6),-(a4)
	move.l (a6),-(a4)		; conserve x
	move #12,-(a4)			; compteur de boucle
	tst.b d2			; lambert1 ?
	beq.s .lambert0
	bclr #7,(a6)	; efface le signe -> abs(x)
	bra.s .lb0
.lambert0:
	clr.l -(a6)
	move.l #$3ff00000,-(a6)		; valeur 1.0
	bsr fplus
.lb0:
	bsr loga		; ln(-x) (lambert1) ou ln(x+1) (lambert0)
.lambloop:
	movem.l (a6),a2-a3	; conserve x courant
	movem.l a2-a3,-(a6)	; fdup (x x)
	bsr expo					; (x ex)
	lea 16(a6),a0
	move.l -(a0),-(a6)
	move.l -(a0),-(a6)
	move.l -(a0),-(a6)
	move.l -(a0),-(a6)	; fover fover (x ex x ex)
	bsr ffois					; (x ex x*ex)
	move.l 4(a6),-(a6)
	move.l 4(a6),-(a6)	; fdup (x ex x*ex x*ex)
	move.l 6(a4),-(a6)
	move.l 2(a4),-(a6)	; x0
	bsr fmoins				; (x ex x*ex x*ex-x0=f(x))
	bsr frot					; (x f(x) ex x*ex)
	bsr fplus				; (x f(x) ex+x*ex=f'(x))
	bsr fdiv					; (x f(x)/f'(x))
	bsr fmoins				; x' = x-f(x)/f'(x)
	cmp.l 4(a6),a3			; meme partie basse?
	bne.s .encore			; non on continue
	cmp.l (a6),a2			; meme partie haute?
	beq.s .exit				; oui! x ne bouge plus
.encore:
	subq #1,(a4)			; boucle
	bpl.s .lambloop		; tant que >=0
.exit:
	lea 10(a4),a4			; enlŠve le compteur et x0
	rts




	endif

; ***********
; fin distinction copro ou pas



; sur la pile (a6) contient le r‚el
; en sortie dans #affbuf se trouve la chaine
; utilise d0-d7 et a0-a3

subaff: lea affbuf,a3
   move.l (a6)+,d0
   bpl.s .lb0
   move.b #'-',(a3)+
   bclr #31,d0
   bra.s .lbb
.lb0: move.b #' ',(a3)+
.lbb: move.l (a6)+,d1
   bne.s .lba
   tst.l d0
   bne.s .lba
   move.l #$20300000,affbuf ; espace, z‚ro, fin
   rts
.lba: moveq #8,d7          ; 9 boucles de 10^+-256 … 10^+-1
   moveq #0,d5          ; puissance de 10
   btst #30,d0          ; si il est mis l'exposant est au moins $400 donc >0
   beq .negatif
   lea posdata+72,a2
.lb1: move.l -(a2),d3
   move.l -(a2),d2
   cmp.l d0,d2
   bmi.s .non
   bne.s .oui
   cmp.l d3,d1
   bcs.s .oui
.non: move d5,a0
   move d7,a1
   bsr subdiv
   move a1,d7
   move a0,d5
   bset d7,d5
.oui: dbf d7,.lb1
   moveq #1,d7
   cmp #8,d5
   bpl .suite
   move d5,d7
   addq #1,d7
   moveq #0,d5
   bra .suite
.negatif: lea negdata+72,a2
 .lb2: move.l -(a2),d3
   move.l -(a2),d2
   cmp.l d2,d0
   bmi.s .non2
   bne.s .oui2
   cmp.l d1,d3
   bcs.s .oui2
.non2: move d5,a0
   move d7,a1
   ; modif
   movem.l 72(a2),d2-d3
   bsr submul
   ; avant c'‚tait
	;   bsr subdiv
   move a1,d7
   move a0,d5
   bset d7,d5
.oui2: dbf d7,.lb2
   cmp.l #$3ff00000,d0
   bpl.s .lbe
.lbd:
	; modif
	movem.l 72(a2),d2-d3
	move d5,a0
	bsr submul
	; avant c'‚tait
;	move.l (a2)+,d2
;   move.l (a2),d3
;   move d5,a0
;   bsr subdiv
   move a0,d5
   addq #1,d5
.lbe: moveq #1,d7     ; normalement virgule aprŠs le premier chiffre
   cmp #5,d5
   bpl.s .lb5
   tst d5
   beq.s .lb5
   moveq #0,d7     ; sinon pas de virgule !, elle y est d‚j….
   move.b #'0',(a3)+
   move.b #'.',(a3)+ ; puisque je la mets !
   subq #1,d5
   bra.s .lb3
.lb4: move.b #'0',(a3)+
.lb3: dbf d5,.lb4
   moveq #0,d5
.lb5: neg d5
.suite: moveq #10,d6       ; 11 chiffres
   move.l d0,d2
   swap d2
   lsr #4,d2
   sub #$3ff,d2           ; d2 est l'exposant
   and.l #$000fffff,d0    ; on vire l'exposant
   bset #20,d0            ; ajout du bit implicite
   subq #3,d2
   neg d2
.lb6: lsr.l d0
   roxr.l d1
   dbf d2,.lb6               ; now la partie entiŠre de la mantisse est dans le
.lb8: swap d0                ; mot sup‚rieur de d0
   add.b #'0',d0
   move.b d0,(a3)+
   subq #1,d7
   bne.s .lb7
   move.b #'.',(a3)+
.lb7: clr d0
   swap d0
   lsl.l d1
   roxl.l d0
   move.l d1,d3
   move.l d0,d2
   lsl.l d1
   roxl.l d0
   lsl.l d1
   roxl.l d0
   add.l d3,d1
   addx.l d2,d0
   dbf d6,.lb8
   cmp.b #'5',-(a3)
   bmi.s .lb9
   move.l a3,a2
.la0: cmp.b #".",-(a2)
   beq.s .la1
   addq.b #1,(a2)
   cmp.b #'9'+1,(a2)
   bne.s .lb9
   move.b #'0',(a2)
   bra.s .la0
.la1: move.l a2,a0
.la2: cmp.l #affbuf+2,a2
   bmi.s .la3
   addq.b #1,-(a2)
   cmp.b #'9'+1,(a2)
   bne.s .lb9
   move.b #'0',(a2)
   bra.s .la2
.la3: move.b #'1',(a2)
   tst d5
   beq.s .la4
   addq #1,d5
   bra.s .lb9
.la4: move.b #'0',(a0)+
   move.b #'.',(a0)
.lb9: cmp.b #'0',-(a3)
   beq.s .lb9
   cmp.b #'.',(a3)
   beq.s .lb10
   addq.l #1,a3
.lb10: tst d5
   beq.s .fin
   bpl.s .lb11
   move.b #'e',(a3)+
   move.b #'-',(a3)+
   neg d5
   bra.s .lb12
.lb11: move.b #'e',(a3)+
.lb12: addq.l #1,a3
   cmp #10,d5
   bmi.s .lb13
   addq.l #1,a3
   cmp #100,d5
   bmi.s .lb13
   addq.l #1,a3
.lb13: move.l a3,a0
   ext.l d5
.lb14: divs #10,d5
   swap d5
   add.b #'0',d5
   move.b d5,-(a0)
   swap d5
   ext.l d5
   bne.s .lb14
.fin: clr.b (a3)
   rts
; a0 pointe sur la chaine : [+/-][xxxx][./,xxxx][e/E[+/-][xxxx]]
; en sortie d0/d1 le r‚el. erreur=1 si erreur...
; a1 conserve les signes (mantisse puis exposant)
; a2 pointe sur les donn‚es ( chiffres puis puissances de 10 )
; a3 sert … d‚caler l'exposant si il y a des chiffres aprŠs la virgule
; d0-d7,a0-a3 utilis‚s

subval: sub.l a1,a1
   move #1,a3
   cmp.b #'-',(a0)
   bne.s .lb0
   move #1,a1
   addq.l #1,a0
   bra.s .lb1
.lb0: cmp.b #'+',(a0)
   bne.s .lb1
   addq.l #1,a0
.lb1: moveq #0,d0
   moveq #0,d1
.lb2: move.b (a0),d7
   beq .fin
   cmp.b #".",d7
   beq.s .virg
   cmp.b #',',d7
   bne.s .lb20
.virg: sub.l a3,a3
   addq.l #1,a0
   bra.s .lb2
.lb20: cmp.b #"e",d7
   beq.s .exp
   cmp.b #'E',d7
   beq.s .exp
   cmp.w #1,a3
   beq.s .lb21
   subq #1,a3
.lb21: tst.l d0
   beq.s .lb3
   add.l #$100000,d0
   move.l d0,d2
   move.l d1,d3
   add.l #$200000,d2
   bsr subplus
.lb3: moveq #0,d7
   move.b (a0)+,d7
   sub.b #'0',d7
   beq.s .lb2
   cmp.b #10,d7
   bmi.s .lb31
   move #1,erreur
   rts
.lb31: lea chdata,a2
   add d7,d7
   move -2(a2,d7.w),d2
   swap d2
   clr d2
   moveq #0,d3
   bsr subplus
   bra.s .lb2
.exp: addq.l #1,a0
   cmp #1,a1
   bne.s .lb4
   moveq #31,d7
   bset d7,d0
.lb4: sub.l a1,a1
   moveq #0,d4
   cmp.b #'-',(a0)
   bne.s .lb5
   move #1,a1
   addq.l #1,a0
   bra.s .lb6
.lb5: cmp.b #'+',(a0)
   bne.s .lb6
   addq.l #1,a0
.lb6: move.b (a0)+,d7
   beq.s .lb7
   ext.w d7
   sub.w #'0',d7
   muls #10,d4
   add d7,d4
   bra.s .lb6
.fin: moveq #0,d4
   cmp #1,a1
   bne.s .lb71
   moveq #31,d7
   bset d7,d0
.lb7: cmp #1,a1
   bne.s .lb71
   neg d4
.lb71: cmp #1,a3
   beq.s .lb8
   add a3,d4
.lb8: lea posdata,a2
   tst d4
   bpl.s .lb81
   neg d4
   lea negdata,a2
.lb81: move d4,a3
.lb9: move a3,d4
   beq.s .sortie
   lsr d4
   bcc.s .lb10
   move d4,a3
   move.l (a2)+,d2
   move.l (a2)+,d3
   bsr submul
   bra.s .lb9
.lb10: addq.l #8,a2
   move d4,a3
   bra.s .lb9
.sortie: rts

   COPIE fdup,y201
fdup: move.l 4(a6),-(a6)
   move.l 4(a6),-(a6)
y201: rts

   COPIE fdrop,y169
fdrop: addq.l #8,a6
y169: rts

   SAUT
fpt: bsr subaff
   lea affbuf,a0
   cmp.b #' ',(a0)+
   beq.s .areu
   subq.l #1,a0
.areu:
   bsr write_str
   rts

   SAUT
fval: move.l (a6),a0
   bsr subval
   move.l d1,(a6)
   move.l d0,-(a6)
   rts

   ASS 0
empilfl: move.l (a5)+,-(a6)
   move.l (a5)+,-(a6)
   rts

   COPIE fptpt,y170,1
fptpt: jsr fdup
   jsr fpt
y170: rts

   COPIE fswap,y202
fswap: move.l a6,a0
   lea 8(a6),a1
   move.l (a1),d1
   move.l (a0),(a1)+
   move.l d1,(a0)+
   move.l (a1),d1
   move.l (a0),(a1)
   move.l d1,(a0)
y202: rts

   COPIE fover,y171
fover: move.l 12(a6),-(a6)
   move.l 12(a6),-(a6)
y171: rts

   COPIE frcl,y172
frcl: move.l (a6),a0
   move.l 4(a0),(a6)
   move.l (a0),-(a6)
y172: rts

	SAUT
ifrcl:
	move.l (a6),a0
	movem.l (a0),d0-d1
	ror #8,d0
	ror #8,d1
	swap d0
	swap d1
	ror #8,d0
	ror #8,d1
	move.l d0,(a6)
	move.l d1,-(a6)
	rts

   COPIE fsto,y173
fsto: move.l (a6)+,a0
   move.l (a6)+,(a0)+
   move.l (a6)+,(a0)
y173: rts

	SAUT
ifsto: move.l (a6)+,a0
	movem.l (a6)+,d0-d1
	ror #8,d0
	ror #8,d1
	swap d0
	swap d1
	ror #8,d0
	ror #8,d1
	move.l d1,(a0)+
	move.l d0,(a0)
	rts

   COPIE fdiff,y174b
fdiff: moveq #1,d1
   move.l a6,a0
   lea 8(a6),a1
   add.w #16,a6
   cmp.l (a0)+,(a1)+
   bne.s .fin
   cmp.l (a0)+,(a1)+
   bne.s .fin
   moveq #0,d1
.fin: move.l d1,-(a6)
y174b: rts

   COPIE fegal,y174
fegal: moveq #0,d1
   move.l a6,a0
   lea 8(a6),a1
   add.w #16,a6
   cmp.l (a0)+,(a1)+
   bne.s .fin
   cmp.l (a0)+,(a1)+
   bne.s .fin
   moveq #1,d1
.fin: move.l d1,-(a6)
y174: rts

   SAUT
finf: move.l (a6)+,d0
   bmi.s .lb0
   move.l (a6)+,d1		; ici y>=0
   move.l (a6)+,d2
   bmi.s .oui				; si x<0, x < y, donc oui
   cmp.l d0,d2				; et x>=0, donc on compare
   bmi.s .oui
   bne.s .non
   cmp.l (a6),d1
   beq.s .non
   bcc.s .oui
.non: moveq #0,d0
   move.l d0,(a6)
   rts
.oui: moveq #1,d0
   move.l d0,(a6)
   rts
.lb0: moveq #31,d7	; ici y<0
   bclr d7,d0
   move.l (a6)+,d1
   move.l (a6)+,d2
   bpl.s .non			; ici x>=0 donc non car x>y
   bclr d7,d2
   cmp.l d0,d2			; ici x et y <0, alors on compare
   bmi.s .non
   bne.s .oui
   cmp.l (a6),d1
   bcs.s .oui
;   beq.s .oui
   bra.s .non

	SAUT
finfegal:
	bsr.s fsup
	bchg #0,3(a6)
	rts

	SAUT
fsupegal:
	bsr.s finf
	bchg #0,3(a6)
	rts

   SAUT
fsup: move.l (a6)+,d0
   bmi.s .lb0
   move.l (a6)+,d1		; ici y>=0
   move.l (a6)+,d2
   bmi.s .non				; si x<0, x < y, donc non
   cmp.l d0,d2				; et x>=0, donc on compare
   bmi.s .non
   bne.s .oui
   cmp.l (a6),d1
   bcc.s .non
.oui: moveq #1,d0
   move.l d0,(a6)
   rts
.non: moveq #0,d0
   move.l d0,(a6)
   rts
.lb0: moveq #31,d7	; ici y<0
   bclr d7,d0
   move.l (a6)+,d1
   move.l (a6)+,d2
   bpl.s .oui			; ici x>=0 donc oui x>y
   bclr d7,d2
   cmp.l d0,d2			; ici x et y <0, alors on compare
   bmi.s .oui
   bne.s .non
   cmp.l (a6),d1
   bcs.s .non
   beq.s .non
   bra.s .oui

   SAUT
appl_getinfo:
	A1 130,1,4,0

   COPIE fabs,y200
fabs: bclr #7,(a6)
y200: rts

   COPIE pee,y175,1
pee: move.l #pi+4,a0
   move.l (a0),-(a6)
   move.l -(a0),-(a6)
y175: rts

   COPIE fneg,y176
fneg: bchg #7,(a6)
y176: rts

   SAUT
power: bsr fswap
   bsr loga
   bsr ffois
   bra expo

   SAUT
appl_trecord:
	A1 15,1,1,1

   COPIE ffois2,y177
ffois2: move.l (a6)+,d2
   move.l (a6),d0
   beq.s y177
   swap d0
   cmp #8000,d0
   beq.s y177
   lsl #4,d2
   add d2,d0
   move d0,(a6)
y177: rts

	COPIE sign,y178a
sign: moveq #-1,d1
	move.l (a6),d0
	beq.s y178a
	bmi.s .lb0
	moveq #1,d1
.lb0: move.l d1,(a6)
y178a: rts

   COPIE fsign,y178
fsign: moveq #0,d0
   move.l (a6)+,d1
   beq.s .fin
   bclr #31,d1
   beq.s .un
   tst.l d1
   beq.s .fin
   moveq #-1,d0
   bra.s .fin
.un: moveq #1,d0
.fin: move.l d0,(a6)
y178: rts

   COPIE fsurr,y179
fsurr: move.l (a6)+,-(a4)
   move.l (a6)+,-(a4)
y179: rts

   COPIE rsurf,y180
rsurf: move.l (a4)+,-(a6)
   move.l (a4)+,-(a6)
y180: rts

   COPIE frot,y181
frot: lea 8(a6),a1
   lea 16(a6),a0
   move.l (a6),d0
   move.l (a1),(a6)+
   move.l (a0),(a1)+
   move.l d0,(a0)+
   move.l (a6),d0
   move.l (a1),(a6)
   move.l (a0),(a1)
   move.l d0,(a0)
   subq.l #4,a6
y181: rts

   COPIE fpick,y182
fpick: move.l (a6),d0
   if STE=0
   	lea 0(a6,d0*8),a0
   else
   	asl.l #3,d0
   	lea 0(a6,d0),a0
   endif
   move.l (a0),(a6)
   move.l -(a0),-(a6)
y182: rts

   COPIE islast,y183
islast: move.l (a6)+,a0
   clr.l 8(a0)
y183: rts

   COPIE pempty,y184,1
pempty: move.l (a6)+,a0
   move.l (a0),a2
   move.l a2,d7
   clr.l (a0)
.lb1: tst.l d7
   beq.s y184
   move.l 8(a2),d7
   jsr libere
   move.l d7,a2
   bra.s .lb1
y184: rts

   SAUT
compset: move.l (a6),a1
   move.l #setdat,a2
   move.l a2,(a6)
   move (a1)+,(a2)+
   move (a1)+,d0
   move d0,(a2)+
   move d0,d1
   lsr #3,d0
   and #$7,d1
   bne.s .lb1
   subq #1,d0
.lb1: move.b (a1)+,(a2)
   not.b (a2)+
   dbf d0,.lb1
   clr.b (a2)
   tst d1
   beq.s .lb2
   moveq #8,d2
   sub d1,d2
   lsr.b d2,d0
   and.b d0,-(a2)
.lb2: rts

   COPIE pint,y185
pint: move.l (a6)+,d0
   move.l a6,-(sp)
   moveq #4,d1
   move.l d1,-(sp)
   move d0,-(sp)
   UP
   GEMDOS 64,12
y185: rts

   COPIE pflt,y186
pflt: move.l (a6)+,d0
   move.l a6,-(sp)
   moveq #8,d1
   move.l d1,-(sp)
   move d0,-(sp)
   addq.l #8,a6
   GEMDOS 64,12
y186: rts

   SAUT
pstr: move.l (a6)+,d0
   move.l (a6)+,a3
   move.l a3,a0
   move -2(a3),d7
.lb1: tst.b (a0)+
   bne.s .lb1
   move.l a0,d5
   sub.l a3,a0
   move a0,-(a3)
   addq #2,a0
   move.l a3,-(sp)
   move.l a0,-(sp)
   move d0,-(sp)
   GEMDOS 64,12
   move d7,(a3)+
   rts

   COPIE pset,y187
pset: move.l (a6)+,d0
   move.l (a6)+,a3
   addq.l #2,a3
   moveq #0,d7
   move (a3)+,d7
   move d7,d6
   lsr #4,d7
   and #$f,d6
   beq.s .lb1
   addq #1,d7
.lb1: add d7,d7
   move.l a3,-(sp)
   move.l d7,-(sp)
   move d0,-(sp)
   GEMDOS 64,12
y187: rts

   COPIE pstruc,y188
pstruc: move.l (a6)+,d0
   move.l (a6)+,a3
   move.l 4(a3),d6
   move.l (a3),-(sp)
   move.l d6,-(sp)
   move d0,-(sp)
   GEMDOS 64,12
y188: rts

	SAUT
pline:
	move.l (a6)+,d7		; handle
	move.l (a6)+,a3		; chaine
	move.l a3,a0
.lb0:
	tst.b (a0)+				; fin de chaine?
	bne.s .lb0
	sub.l a3,a0
	subq.l #1,a0			; taille de la chaine
	move.l a3,-(sp)		; buffer
	move.l a0,-(sp)		; taille
	move d7,-(sp)			; handle
	GEMDOS 64,12			; fwrite
	pea .lb1(pc)			; fin de ligne
	moveq #2,d0
	move.l d0,-(sp)
	move d7,-(sp)
	GEMDOS 64,12			; ‚crite CR, LF
	rts
.lb1:
	dc.b 13,10

	SAUT
rline:
	move.l (a6)+,d7		; handle
	move.l (a6),a3			; chaine
	move.l a3,d5			; pour savoir si on a lu quelque chose
	move.w -2(a3),d6		; taille max autoris‚e
.cherche_debut:
	bsr.s .get_char
	ble.s .eof
	tst.b d1
	beq.s .cherche_debut
	cmp.b #13,d1
	beq.s .cherche_debut
	cmp.b #10,d1
	beq.s .cherche_debut
.lire:
	move.b d1,(a3)+		; on a eu un caractŠre
	subq #1,d6				; r‚duire la taille
	beq.s .eos				; max atteint, on arrete
	bsr.s .get_char
	ble.s .eof
	tst.b d1
	beq.s .eof
	cmp.b #13,d1
	beq.s .eof
	cmp.b #10,d1
	bne.s .lire
.eos:
	moveq #-1,d0			; ici fin de chaine
	bra.s .lb0
.eof:
	moveq #1,d0
.lb0:
	clr.b (a3)
	cmp.l a3,d5				; a-t-on avanc‚?
	beq.s .fin				; non, donc renvoyer z‚ro, fin de fichier
	move.l d0,(a6)
	rts
.fin:
	clr.l (a6)
	rts
.get_char:
	pea (a6)					; lire sur la pile
	moveq #1,d0
	move.l d0,-(sp)		; un caractŠre
	move d7,-(sp)
	GEMDOS 63,12			; fread
	move.b (a6),d1
	tst.l d0
	rts

   COPIE rint,y189
rint: move.l a6,-(sp)
   moveq #4,d6
   move.l d6,-(sp)
   move 2(a6),-(sp)
   GEMDOS 63,12
   cmp d6,d0
   bne.s .lb1
   moveq #1,d1
   move.l d1,-(a6)
   bra.s y189
.lb1: clr.l (a6)
y189: rts


   SAUT
rstr: move.l (a6)+,d5
   move.l (a6),a3
   move.l a6,-(sp)
   moveq #2,d0
   move.l d0,-(sp)
   move d5,-(sp)
   GEMDOS 63,12
   cmp #2,d0
   bne.s .ach
   move.l a3,-(sp)
   moveq #0,d7
   move (a6),d7
	move.l d7,-(sp)
   move d5,-(sp)
   GEMDOS 63,12
   cmp.l d7,d0
   bne.s .ach
   moveq #1,d0
   move.l d0,(a6)
   rts
.ach: clr.l (a6)
   rts

   COPIE rflt,y190
rflt: subq.l #4,a6
   move.l a6,-(sp)
   moveq #8,d6
   move.l d6,-(sp)
   move 6(a6),-(sp)
   GEMDOS 63,12
   cmp d6,d0
   bne.s .ach
   moveq #1,d1
   move.l d1,-(a6)
   bra.s y190
.ach: addq.l #4,a6
   clr.l (a6)
y190: rts

   SAUT
rset: move.l (a6)+,d0
   move.l (a6),a3
   addq.w #2,a3
   move (a3)+,d7
   move d7,d6
   lsr #4,d7
   and #$f,d6
   beq.s .lb1
   addq #1,d7
.lb1: add d7,d7
   move.l a3,-(sp)
   move.l d7,-(sp)
   move d0,-(sp)
   GEMDOS 63,12
   clr.l (a6)
   cmp d0,d7
   bne.s .ach
   moveq #1,d1
   move.l d1,(a6)
.ach: rts

   COPIE rstruc,y191
rstruc: move.l (a6)+,d0
   move.l (a6),a3
   move.l (a3)+,-(sp)
   move.l (a3),d7
   move.l d7,-(sp)
   move d0,-(sp)
   GEMDOS 63,12
   clr.l (a6)
   cmp.l d7,d0
   bne.s y191
   moveq #1,d1
   move.l d1,(a6)
y191: rts

   SAUT
cmove: move.l (a6)+,d0
   move.l (a6)+,a0
   move.l (a6)+,a1
   moveq #0,d1
   move sizeptr,d1
   asl.l d1,d0
   move.l d0,d1
   move.l d0,d7
   and #$f,d1
   asr.l #4,d0
   tst sizeptr
   beq.s .oct
   cmp.l a0,a1
   bmi.s .lb4
   bra.s .lba
.lb1:
   rept 4
   move.l (a1)+,(a0)+
   endr
.lba:
	subq.l #1,d0
	bpl.s .lb1
	bra.s .lbb
.lb3: move.b (a1)+,(a0)+
.lbb: dbf d1,.lb3
.fin: rts
.lb4: add.l d7,a0
   add.l d7,a1
   bra.s .lbc
.lb5:
   rept 4
   move.l  -(a1),-(a0)
   endr
.lbc:
   subq.l #1,d0
   bpl.s .lb5
   bra.s .lbd
.lb7: move.b -(a1),-(a0)
.lbd: dbf d1,.lb7
   rts
.oct: cmp.l a0,a1
   bmi.s .lb9
   bra.s .lbe
.lb8:
   rept 16
   move.b (a1)+,(a0)+
   endr
.lbe:
	subq.l #1,d0
	bpl.s .lb8
   bra.s .lbb
.lb9: add.l d7,a0
   add.l d7,a1
   bra.s .lbf
.lb10:
   rept 16
   move.b -(a1),-(a0)
   endr
.lbf:
	subq.l #1,d0
	bpl.s .lb10
   bra.s .lbd

   SAUT
vqt_devinfo:
	V1 248,0,1,0

   SAUT
vm_filename:
	bsr _intin_str
	V5 5,0,100

   SAUT
v_meta_extents:
	V1 5,2,0,98

   SAUT
vm_pagesize:
	moveq #0,d0
	move.l a6,a0
	lea -4(a6),a6
	move.l a6,a1
	move.l (a0)+,(a1)+
	move.l (a0),(a1)
	move.l d0,(a0)
	V1 5,0,3,99

   SAUT
setable: move.l (a6)+,d7
   bmi.s .lb0
   move.l szone,-(sp)
   GEMDOS $49,6
   move.l d7,-(sp)
   GEMDOS $48,6
   move.l d0,szone
.lb0: move.l szone,a0
   clr.l (a0)+
   clr.l (a0)+
   moveq #-1,d0
   move.l d0,(a0)
   move.l topmem,botmem
   rts

   SAUT
setdigits: move.l (a6)+,d0
   bgt.s .lb0
   moveq #1,d0
.lb0: cmp #18,d0
   bmi.s .lb1
   moveq #17,d0
.lb1: move d0,fixn
   rts

   ASS 23
fleche: rts

   ASS 36
andfl: tst.l (a6)
   beq.s .lb0
   UP
   addq.l #2,a5
   rts
.lb0: add.w (a5)+,a5
   rts

   ASS 38
andorpt: tst.l (a6)
   beq.s .lb0
   moveq #-1,d0
   move.l d0,(a6)
.lb0: rts

   ASS 37
orfl: tst.l (a6)
   beq.s .lb0
   add.w (a5)+,a5
   moveq #-1,d0
   move.l d0,(a6)
   rts
.lb0: addq.l #2,a5
   UP
   rts

   COPIE pageclip,y192,1
pageclip:
   move.l fenetre,a0
   lea c_pts,a1
   move.l (a0)+,d0
   move.l d0,(a1)+
   add.l (a0),d0
   sub.l #$10001,d0
   move.l d0,(a1)
   move handle,c_cont+12
   move.l #clip_tab,d1
   moveq #$73,d0
   trap #2
y192: rts
clip_tab: dc.l c_cont,c_int,c_pts,dum,dum
c_cont: dc.w 129,2,0,1,0,0,0,0,0,0,0,0,0
c_int: dc.w 1
c_pts: dc.w 0,0,0,0

   SAUT
v_ftext:
	move #241,d7
	moveq #0,d6
	bra _text

   SAUT
v_clear_disp_list:
	V3 5,22

   SAUT
v_updwk:
	V3 4,0

   COPIE st1,y195
st1: move.l (a6)+,a0
   move.l (a6)+,d0
   subq.l #4,(a0)
   move.l (a0),d1
   move.l d0,0(a0,d1.l)
y195: rts

   COPIE st2,y196
st2: move.l (a6),a0
   move.l (a0),d1
   move.l 0(a0,d1.l),(a6)
   addq.l #4,(a0)
y196: rts

   COPIE st3,y196a
st3: move.l (a6),a0
   move.l (a0),d1
   move.l 0(a0,d1.l),(a6)
y196a: rts


   SAUT
current: move.l (a6)+,a0
	lea thread0,a1		; par defaut le thread0
	move.l thptr,d0
	beq.s .lb0
	move.l d0,a1		; si un thread en cours, on le prend
.lb0:
	move.l a0,34(a1)	; actualise sa pile
   lea pilbase,a1
   move.l (a1),a2
   sub.l a2,a6
   move.l a6,(a2)
   move.l a0,(a1)
   move.l (a0),a6
   add.l a0,a6
	rts

   COPIE stack0,y203,1
stack0: move.l #pile+4100,d0
	and.b #$fc,d0
	move.l d0,-(a6)
y203:   rts

   SAUT
cache: move.l (a6)+,.lb1
	if STE=0
	   move.l #.lb0,-(sp)
  		XBIOS 38,6
   	rts
		.lb0: move.l .lb1,d0
   	movec d0,cacr
   endif
   rts
.lb1: dc.l 0

cache_off:
	if STE=0
		pea .off(pc)
		XBIOS 38,6
		rts
		.off:
		cmp #40,cpu_value+2
		bpl.s .lb0
		movec cacr,d0
		or #$808,d0
		movec d0,cacr			  ; vide le cache
		rts
	.lb0:
		dc.w $F4F8		; flush instruction cache
	endif
	rts

cache_off2:
	cmp #40,cpu_value+2
	bmi.s .exit
	pea .off(pc)
	XBIOS 38,6
.exit:
	rts
.off:
	if STE=0
		movec cacr,d0
		move.l d0,sauve_cacr
		moveq #0,d0
		dc.w $F4F8			; flush caches
		movec d0,cacr		; coupe tous les caches
		nop
	endif
	rts

cache_on2:
	cmp #40,cpu_value+2
	bmi.s cache_off	; vide juste les caches sur 68030
	pea .off(pc)
	XBIOS 38,6
	rts
.off:
	if STE=0
		move.l sauve_cacr(pc),d0
		dc.w $F4F8			; sait-on jamais
		movec d0,cacr
		nop
	endif
	rts
sauve_cacr: dc.l 0

   COPIE set_redraw,wds,1
set_redraw:
	lea redrawdat+12,a0
	rept 5
		move.l (a6)+,d0
		move d0,-(a0)
	endr
	clr -(a0)        ; first rectangle pas encore appel‚
wds:	rts

   COPIE get_xywh,wsd
get_xywh:
	move.l (a6)+,a0	; utilis‚ par gem_input, ne pas modifier
	moveq #0,d0
	rept 4
   	move (a0)+,d0
	   move.l d0,-(a6)
	endr
wsd:	rts

   SAUT
get_xyxy:
	move.l (a6)+,a0
	moveq #0,d4
	moveq #0,d5
	moveq #0,d0
	moveq #0,d1
	moveq #0,d2
	moveq #0,d3
	tst.b xy_flag
	beq.s .lb0
	move.l fenetre,a1
	move (a1)+,d4
	move (a1),d5
.lb0:
	movem.w (a0)+,d0-d3
   sub d4,d0
   add d0,d2
   subq #1,d2
   sub d5,d1
   add d1,d3
   subq #1,d3
   move.l d0,-(a6)
   move.l d1,-(a6)
   move.l d2,-(a6)
   move.l d3,-(a6)
   rts

   COPIE _work_out,sqw,1
_work_out:
	move.l #work_out,-(a6)
sqw: rts

	SAUT
vqt_f_extent:
	bsr _intin_str		; renvoit la longueur dans d2
	V5 240,0,0

; pour les fonctions ayant d2 (taille intin) d‚j… initilalis‚e
; et aucun paramŠtre … passer
; V5 opcode,ptsin,sub_code

vdicinq:
   lea control(pc),a0
	move d0,(a0)+
	move d1,(a0)+
	move.l d2,(a0)+
	move.l d3,(a0)+
	move handle,(a0)
	VDI
	rts

_intin_str:
	lea intin,a1
_intin_str2:
	move.l (a6)+,a0
	moveq #0,d0
	move.l a0,d2
.lb0:
	move.b (a0)+,d0
	beq.s .fin
	move d0,(a1)+
	bra.s .lb0
.fin:
	sub.l a0,d2
	neg.l d2
	subq.l #1,d2      ; taille dans d2
	rts

_intin_str16:
	lea intin,a1
	move.l (a6)+,a0
	move.l a0,d2
.lb0:
	move (a0)+,(a1)+
	bne.s .lb0
	sub.l a0,d2
	neg.l d2
	subq.l #1,d2
	rts

   SAUT
_redraw:
   moveq #12,d7      ; next par d‚faut
   moveq #0,d4
   moveq #0,d5       ; offset nul par d‚faut
   tst.b xy_flag
   beq.s .pas_off
  	move.l fenetre,a0
   move.w (a0)+,d4
   move.w (a0),d5
.pas_off:
	lea redrawdat,a3
	tst (a3)+
	beq .premier      ; premier appel
	bpl .suivant      ; appel normal
	clr.l -(a6)       ; si c'est n‚gatif, il n'y a d‚j… plus de rectangles!
	rts
.premier:
	move #1,wu_int
	GEM_AES wind_update
	GEM_VDI hide_mouse
	move #1,-2(a3)    ; ce n'est plus le premier appel
	addq.l #2,a3
	move.l (a3)+,d0   ; x et y
	sub.l #$10001,d0  ; pour faire joli
	add.l d0,(a3)     ; remplace l et h par x' et y' (fastoche)
	lea -6(a3),a3     ; revient sur handle
	lea wg_int,a0
	move (a3)+,(a0)+
	move #4,(a0)
	GEM_AES wind_get0 ; work_area pour limiter les valeurs de set_redraw
	lea wg_out+2,a0
	movem.w (a0)+,d0-d3
	cmp (a3)+,d0
	bmi.s .g0
	move d0,-2(a3)
.g0:
	cmp (a3)+,d1
	bmi.s .g1
	move d1,-2(a3)
.g1:
	subq #1,d0
	add d0,d2
	cmp (a3)+,d2
	bpl.s .g2
	move d2,-2(a3)
.g2:
	subq #1,d1
	add d1,d3
	cmp (a3),d3
	bpl.s .g3
	move d3,(a3)
.g3:
	lea -8(a3),a3     ; retour sur le handle
	moveq #11,d7      ; premier rectangle
.suivant:
	lea wg_int,a0
	move (a3)+,(a0)+  ; le handle
	move d7,(a0)      ; first ou next
	GEM_AES wind_get0 ; le rectangle
	moveq #12,d7      ; si il y en a un autre, plus le premier
   lea wg_out,a0
   tst (a0)+
   beq .dernier      ; si 0, une erreur, on arrˆte l…!
   tst.l 4(a0)       ; l et h
   beq .dernier      ; si nuls, il n'y a plus de rectangles
   moveq #0,d3
   move (a0)+,d3     ; x
   add d3,2(a0)      ; l+x
   cmp (a3)+,d3
   bpl.s .lb0
   move -2(a3),d3
.lb0:
	moveq #0,d2
	move (a0)+,d2     ; y
	add d2,2(a0)      ; h+y
	cmp (a3)+,d2
	bpl.s .lb1
	move -2(a3),d2
.lb1
	sub.l #$10001,(a0)
	moveq #0,d1
	move (a0)+,d1     ; x'
	cmp (a3)+,d1
	bmi.s .lb2
	move -2(a3),d1
.lb2:
	moveq #0,d0
	move (a0)+,d0
	cmp (a3)+,d0
	bmi.s .lb3
	move -2(a3),d0
.lb3:
	lea -10(a3),a3    ; revient sur la handle
	cmp d3,d1
	bmi .suivant      ; pas d'intersection car x'<x
	cmp d2,d0
	bmi .suivant      ; meme chose, y'<y
	sub.l d4,d3
	sub.l d4,d1
	sub.l d5,d2
	sub.l d5,d0       ; d‚cale les coordonn‚es en mode relatif
	movem.l d0-d3,-(a6)  ; sinon donne x y x' y'
	moveq #1,d0
	move.l d0,-(a6)   ; et le flag 1, rectangle correct
   bra.s .fin
.dernier:
	clr wu_int
	GEM_AES wind_update  ; libŠre l'‚cran
	GEM_VDI show_mouse
	move #-1,redrawdat   ; c'est fini
	clr.l -(a6)
.fin:
	moveq #4,d0
	move.l d0,wg_int     ; wind_get normal pour fastopen
	rts

   SAUT
vst_arbpt:
	V1 246,0,1,0

   SAUT
vst_setsize:
	V1 252,0,1,0

   SAUT
vst_skew:
	V1 253,0,1,0


playdata: dc.b $81       ; $80 mono, 0-1-2-3 pour 6, 12, 25, 50 kHz
          dc.b $01       ; 8 bits, pas de r‚p‚tition; 3 si r‚p‚tition, et $8x si 16 bits SAGA
          dc.l 0			 ; timer de fin d'un son SAGA ou z‚ro si le son est fini

   SAUT
play: tst.b is_saga
	bne.s _saga
	tst.l (a6)				; si -1, attendre fin du son
	bmi.s .wait
	move.l #_play,-(sp)	; sinon stopper (0) ou lancer.
   move #38,-(sp)
   trap #14
   addq.l #6,sp
   add.w d0,a6
   rts
.wait:
	pea .test_dma(pc)			; octet de controle
	XBIOS 38,6
	btst #0,d0					; ‡a joue encore !
	bne.s .wait
	addq.l #4,a6
	rts
.test_dma:
	move.b $FFFF8901.w,d0		; bit 0 … 1 tant que le son est jou‚
	rts


_play:
	lea $FFFF8900.w,a0   ; sound system
   move.b #0,1(a0)          ; stoppe le DMA
   move.l (a6)+,d0          ; longueur ou option
   beq.s .fin4              ; si z‚ro, arrˆt demand‚ seulement
   move.b 1(a6),3(a0)       ; adresse, high byte
   move.b 2(a6),5(a0)       ; medium
   move.b 3(a6),7(a0)       ; low
   add.l d0,(a6)            ; adresse de fin
   addq.l #1,a6
   move.b (a6)+,$f(a0)
   move.b (a6)+,$11(a0)
   move.b (a6)+,$13(a0)
   move.b playdata,$21(a0)  ; fr‚quence et mono/st‚r‚o
   move.b playdata+1,1(a0)  ; DMA lanc‚, et r‚p‚tition (on/off)
   moveq #8,d0              ; deux longs … restaurer
   rts
.fin4:
	moveq #4,d0
	rts

	if STE=1
		MC68030
	endif

_saga:
	lea $DFF400,a0
	lea playdata(pc),a3
	move.l (a6)+,d0			; taille ou 0/-1
	bmi .wait
	move #1,$DFF096			; stoppe le son
	clr.l 2(a3)					; remet le timer … z‚ro
	tst.l d0
	beq .fin4					; zero, juste arrˆter
	move.l (a6)+,(a0)			; start
	move #$FFFF,8(a0)			; volumes
	lsr.l #1,d0					; pairs
	moveq #2,d1					; 8 bits mono one-shot
	tst.b (a3)
	bmi.s .lb1					; if<0 then mono
	lsr.l #1,d0
	addq #4,d1					; mark stereo
.lb1:
	tst.b 1(a3)
	bpl.s .lb2					; if>0 then 8 bits
	lsr.l #1,d0
	addq #1,d1					; mark 16 bits
.lb2:
	btst #1,1(a3)				; repeat?
	beq.s .lb3
	bclr #1,d1					; one shot
.lb3:
	move d1,10(a0)				; control word
	move.l d0,4(a0)			; pairs
	muls #400,d1:d0
	moveq #3,d2
	move.b (a3),d3
	and.l d2,d3					; frequency 0-1-2-3
	move.w .tab(pc,d3.l*2),d2	; SAGA value
	move d2,12(a0)
	move.l #3546326,d3
	divs d2,d3					; real fequency
	swap d3
	clr d3
	swap d3
	divs.l d3,d1:d0			; d0 = duration in 1/200
	move.l d0,d3
	pea .test_time(pc)
	XBIOS 38,6
	add.l d0,d3
	move.l d3,2(a3)
	move #$8201,$DFF096
	rts
.tab: dc.w 567,283,141,70
.wait:
	move.l 2(a3),d3			; timer de fin
	clr.l 2(a3)					; reset timer
.wait1:
	pea .test_time(pc)		; prend l'heure
	XBIOS 38,6
	cmp.l d0,d3					; d3 atteint?
	bpl.s .wait1
.fin4:
	rts
.test_time:
	move.l $4ba.w,d0
	rts

	if STE=1
		MC68000
	endif


	SAUT
setplay: lea playdata,a0
   move.l (a6)+,d0          ; frequence (0 … 3 )
   bmi.s .lb2					 ; si -1 renvoie la disponibilit‚
   and.b #3,d0
   btst #0,3(a6)            ; mono : 0, 1 st‚r‚o
   bne.s .lb0
   bset #7,d0               ; le bit 7 est le contraire
.lb0: move.b d0,(a0)+
   moveq #1,d0              ; le bit : son allum‚
	tst.b is_saga
	beq.s .lb3					 ; not saga
	btst #1,3(a6)				 ; set for 16 bits
	beq.s .lb3
	bset #7,d0					 ; $8x for 16 bits
.lb3:
	addq.l #4,a6
   tst.l (a6)+              ; 0 une fois, 1 repeat
   beq.s .lb1
   addq #2,d0
.lb1: move.b d0,(a0)        ; voil… !
   rts
   								 ; -1 setplay renvoie 0 (pas de DMA), 1 DMA Atari, 2 DMA SAGA
.lb2:
	moveq #0,d0
	btst #1,snd_value+3
	beq.s .end					; no DMA
	moveq #1,d0
	tst.b is_saga
	beq.s .end					; DMA but no Saga
	moveq #2,d0					; Saga!
.end:
	move.l d0,-(a6)
	rts

replay_flag: dc.w 0         ; mis … 1 par l'interruption pour stopper
replaydat: dc.l .inter      ; routine d'interruption
           dc.l .init       ; initialisation
           dc.b 31          ; data pour timer A
           dc.b 1           ; control pour timer A

.inter:
   move $fb0000,d0
   if STE=0
	   tst.w ($fa8000,d0.w)
	else
		lea $fa8000,a0
		tst.w 0(a0,d0.w)
	endif
   rte

.init:  rts

   SAUT
setreplay:
   lea replaydat,a0
	move.l (a6)+,(a0)+       ; interruption
	move.l (a6)+,(a0)+       ; initialisation
	move.l (a6)+,d0          ; fr‚quence souhait‚e
	bsr.s data_control		 ; place dans (a0) et 1(a0) data et control
									 ; selon la fr‚quence en d0
	rts

; utilise d0 … d5, a0 et a1 et les piles a6 et sp

data_control:
	if STE=1
		movem.l d6-d7,-(sp)
	endif
	move.l d0,d5
	asr.l #1,d5              ; freq/2 pour les restes
	lea .freq,a1
	moveq #7,d1
	move.l #$7fffffff,d2     ; ‚cart au maximum
.lb0:
	if STE=0
		move.l (a1),d3
	   divsl.l d0,d4:d3         ; calcule le data
	else
		move.l (a1),-(a6)
		move.l d0,-(a6)
		movem.l d0-d2/d5,-(sp)
		bsr spdiv
		move.l d2,d3
		move.l d1,d4
		addq.l #4,a6
		movem.l (sp)+,d0-d2/d5
	endif
   cmp.l d4,d5
   bpl.s .lb1
   addq.l #1,d3             ; arrondit au dessus si le reste > freq/2
.lb1: move.l (a1)+,d4
   tst.l d3                 ; data nul?
   beq.s .lb4               ; si oui, il faut passer !
   cmp.l #256,d3
   bpl.s .lb4               ; il faut que data tienne dans un octet
   if STE=0
	   divsl.l d3,d4:d4         ; recalcule la fr‚quence
	else
		move.l d4,-(a6)
		move.l d3,-(a6)
		movem.l d0-d3/d5,-(sp)
		bsr spdiv
		move.l d2,d4
		addq.l #4,a6
		movem.l (sp)+,d0-d3/d5
	endif
   sub.l d0,d4              ; ‚cart avec la fr‚quence demand‚e
   bpl.s .lb2
   neg.l d4                 ; ‚cart en valeur absolue
.lb2: cmp.l d4,d2
   bmi.s .lb4               ; l'‚cart pr‚c‚dent ‚tait moindre
   move.l d4,d2             ; change le maxi
   move.b d3,(a0)           ; data
   move.b d1,1(a0)          ; control
.lb4: subq #1,d1            ; control suivant
   bne.s .lb0
   if STE=1
   	movem.l (sp)+,d6-d7
   endif
   rts
.freq: dc.l 12288,24576,38400,49152,153600,245760,614400

	SAUT
savevdipal:
	VCONTROL 26,0,2,0		; vq_color
	bsr.s _vdipalcomm
	moveq #1,d0
	move.l d0,intin	; color0 et flag=1
	bra.s .lb1
.lb0:
	VDI			; get color
	lea intout+2,a0
	move.l (a0)+,(a3)+	; r,g
	move (a0),(a3)+		; b
	addq #1,intin			; next color
.lb1:
	dbf d3,.lb0
   rts

_vdipalcomm:
	move planes,d0
	move.l (a6)+,a3		; adresse palette
	moveq #1,d3
	cmp #8,d0
	bmi.s .lb0
	moveq #8,d0	; limite … 8 plans = 256 couleurs
.lb0:
	rol.l d0,d3	; d3 nbr de couleurs actuelles
	rts

	SAUT
setvdipal:
	VCONTROL 14,0,4,0		; vs_color
	bsr.s _vdipalcomm
	move #-1,intin	; color -1
	bra.s .lb1
.lb0:
	lea intin,a0
	addq #1,(a0)+		; next color (start zero)
	move.l (a3)+,(a0)+	; r,g
	move (a3)+,(a0)		; b
	VDI
.lb1:
	dbf d3,.lb0
   rts

; " filename" mfdb pal savebitmap
	SAUT
savebitmap:
	move.l (a6)+,d3	; palette
	move.l (a6)+,d4	; mfdb
	clr.l -(a6)
	bsr fcr				; fcreate
	move.l (a6)+,d7	; handle
	move.l d7,d6
	bmi.s .end
	subq.l #4,a6		; handle
	moveq #20,d5
	move.l d5,-(a6)
	move.l d4,-(a6)
	bsr fwr				; fwrite mfdb
	move.l (a6)+,d6
	bmi.s .close
	move.l d4,a0
	move 12(a0),d0		; nombre de plans
	cmp #8,d0
	bgt.s .lb0			; >8 plans, pas de palette … sauver
	moveq #6,d1
	lsl.l d0,d1			; taille de la palette selon les plans
	move.l d7,-(a6)	; handle
	move.l d1,-(a6)
	move.l d3,-(a6)
	bsr fwr				; ‚cris la palette
	move.l (a6)+,d6
	bmi.s .close
.lb0:
	move.l d7,-(a6)
	move.l d4,-(a6)
	bsr imagesize
	move.l d4,a0
	move.l (a0),-(a6)
	bsr fwr
	move.l (a6)+,d6
	bmi.s .close
	moveq #0,d6
.close:
	move.l d7,-(a6)
	bsr fcl
	addq.l #4,a6		; drop
.end:
	move.l d6,-(a6)	; 0 ou code d'erreur
	rts

	SAUT
loadbitmap:
	move.l (a6)+,d3	; palette
	move.l (a6)+,d4	; mfdb
	clr.l -(a6)
	bsr fop				; fopen
	move.l (a6)+,d7	; handle
	move.l d7,d6
	bmi.s .end
	subq.l #4,a6		; handle
	moveq #20,d5
	move.l d5,-(a6)
	move.l d4,-(a6)
	bsr frd				; fread mfdb
	move.l (a6)+,d6
	bmi.s .close
	move.l d4,a0
	move 12(a0),d0		; nombre de plans
	cmp #8,d0
	bgt.s .lb0			; >8 plans, pas de palette … lire
	moveq #6,d1
	lsl.l d0,d1			; taille de la palette selon les plans
	move.l d7,-(a6)	; handle
	move.l d1,-(a6)
	move.l d3,-(a6)
	bsr frd				; lis la palette
	move.l (a6)+,d6
	bmi.s .close
.lb0:
	move.l d7,-(a6)
	move.l d4,-(a6)
	bsr imagesize
	move.l (a6),d3		; taille bloc
	move.l d3,-(a6)
	bsr allot			; alloue le bloc
	move.l d4,a0
	move.l (a6),(a0)	; adresse bloc dans MFDB
	bsr frd				; lit le bloc
	move.l (a6)+,d6
	bmi.s .close
	moveq #0,d6
.close:
	move.l d7,-(a6)
	bsr fcl
	addq.l #4,a6		; drop
.end:
	move.l d6,-(a6)	; 0 ou code d'erreur
	rts

	rts

	SAUT
replay_end: move.l topprg,a0
   lea .r_end,a1
   move.l (a1)+,(a0)+
   move.l (a1)+,(a0)+
   move.l (a1)+,(a0)+
   move (a1),(a0)+
   move.l topprg,a0
.r_end: move.l #.nul,$184.w
   st replay_flag
.nul: rte

   SAUT
replay:
   move #$ff,-(sp)
   GEMDOS 6,4
   tst d0
   bne.s replay
   moveq #10,d7
.vbl:
   XBIOS 37,2
   dbf d7,.vbl
   clr.l   -(SP)
   move   #32,-(SP)       ; superviseur
   trap   #1
   addq.l   #6,SP
   move.l d0,.stk
   move.b $484.w,.clic       ; plus de clic, ni de r‚p‚tition, ni de souris
   clr.b $484.w
	lea .mouseoff,a1
	bsr .ikbd
.vide:	tst.b $108e.w
	bne.s .vide
	move sr,d0
	or #$700,sr
	tst.b $108e.w
	beq.s .ouf
	move d0,sr
	bra.s .vide
.ouf: move.b $fffa07,.mfp
   move.b $fffa09,.mfp+1
   move.b #$20,$fffa07
   move.b #0,$fffa09
   bclr #3,$fffa17
   sf replay_flag
   lea replaydat,a3
   move.l (a3)+,-(sp)   ; routine d'interruption
   move.l (a3)+,-(a6)   ; routine d'initialisation
   moveq #0,d0
   move.b (a3)+,d0
   move d0,-(sp)                  ; data
   move.b (a3),d0
   move d0,-(sp)                  ; control
   clr -(sp)                        ; timer a
   move #31,-(sp)
   trap #14                         ; xbtimer
   add.w #12,sp
   move.l (a6)+,a2
   jsr (a2)
   move $fb0000,d0
   move #$2500,sr                   ; on active
.wait: tst.b replay_flag
   bne .fin                       ; l'interruption elle meme demande la fin
   btst #0,$fffc04                ; midi
   beq.s .rien
   move.b $fffc06,d0
.rien:
	btst #0,$fffc00                ; clavier/souris/joystick
	beq.s .wait
	move.b $fffc02,d0              ; code envoy‚
	cmp.b #$f5,d0
	bcs.s .wait                      ; pas au dessus de F6...
	cmp.b #$f8,d0
	beq.s .souris_nul
	cmp.b #$fb,d0
	beq.s .souris_nul
	cmp.b #$fa,d0
	beq.s .souris_fin
	cmp.b #$f9,d0
	beq.s .souris_fin
	cmp.b #$fe,d0
	beq.s .joystick
	cmp.b #$ff,d0
	bne.s .wait
.joystick: btst #0,$fffc00
   beq.s .joystick
   move.b $fffc02,d0
   btst #7,d0
   beq .wait
   bra .fin
.souris_nul: btst #0,$fffc00
   beq.s .souris_nul
   move.b $fffc02,d0
.lb0: btst #0,$fffc00
   beq.s .lb0
   move.b $fffc02,d0
   bra .wait
.souris_fin: btst #0,$fffc00
   beq.s .souris_fin
   move.b $fffc02,d0
.lb1: btst #0,$fffc00
   beq.s .lb1
   move.b $fffc02,d0
.fin:
	move #$2700,sr
	move.b .mfp,$fffa07
	move.b .mfp+1,$fffa09
	bclr #5,$fffa07
	bclr #5,$fffa0b
	bclr #5,$fffa0f
	bclr #5,$fffa13
	bset #3,$fffa17
   move #$2000,sr
   lea .mouseon,a1
   bsr .ikbd
.vide2: move #$ff,-(sp)
   GEMDOS 6,4
   tst d0
   bne.s .vide2
   move.b .clic,$484.w
   move.l .stk,-(SP)
   move.w   #32,-(SP)            ; mode utilisateur
   trap   #1
   addq.l   #6,SP
   rts
.ikbd: move.l a1,-(sp)
   clr -(sp)
   move #25,-(sp)            ; mouse on ou off
   trap #14
   addq.l #8,sp
   move #37,-(sp)            ; attend deux vbl
   trap #14
   addq.l #2,sp
   move #37,-(sp)
   trap #14
   addq.l #2,sp
   rts

.mouseoff: dc.b $12
.mouseon:  dc.b $8
.stk: dc.l 0
.mfp: dc.b 0,0
.clic: dc.w 1

	SAUT
stallot: btst #0,topprg
	bne.s .mall
	move.l (a6),d0			; d‚j… en st ram, on use le dicco
	addq.l #1,d0
	bclr #0,d0
	move.l topprg,(a6)
	add.l d0,topprg
	rts
.mall: clr -(sp)			; force la st ram
	move.l (a6),-(sp)
	GEMDOS $44,8
	move.l d0,(a6)
	rts

	SAUT
ttallot: btst #0,topprg
	beq.s .mall
	move.l (a6),d0			; d‚j… en tt ram, on use le DICCO
	addq.l #1,d0
	bclr #0,d0
	move.l topprg,(a6)
	add.l d0,topprg
	rts
.mall: move #1,-(sp)   ; tt ram
	move.l (a6),-(sp)
	GEMDOS $44,8
	move.l d0,(a6)
	rts

	SAUT
topsur: move.l topprg,d0
   move.l (a6),topprg
   move.l d0,(a6)
   rts

   SAUT
surtop: move.l (a6)+,topprg
   rts

; renvoie A2 = fin de chaine aprŠs z‚ro
   SAUT
path: move.l (a6)+,a3        ; chaine fichier
   move.l (a6),a0            ; chaine chemin\masque
   lea pad+2,a1              ; chaine r‚sultat
   move.l a1,(a6)
   cmp.l a3,a1					  ; fichier = pad ??
   bne.s .lb0					  ; non, pas de soucis de recouvrement
   move.l a1,a2
.lb1:
	tst.b (a2)+					  ; sinon, aller au bout de la chaŒne
	bne.s .lb1
	lea pad+1028,a3			  ; tout … la fin de pad
.lb2:
	move.b -(a2),-(a3)		  ; y d‚placer fichier
	cmp.l a2,a1
	bne.s .lb2
.lb0:
	bsr.s _copy_path			  ; copie chemin jusqu'au dernier "\"
.lb3: move.b (a3)+,(a2)+     ; ajoute le nom du fichier aprŠs le dernier \
   bne.s .lb3
   rts

	; a0 pointe sur le chemin
	; a1 sur la zone destination
	; en sortie a2 pointe juste aprŠs le dernier "\"
_copy_path:
   move.l a1,a2              ; pointe sur le dernier \, ou le d‚but
.lb1: move.b (a0)+,d0        ; caractŠre suivant
   beq.s .lb3                ; fin de chaine, on saute
   cmp.b #"\",d0             ; est ce un \ ?
   bne.s .lb2
   lea 1(a1),a2              ; si oui, on d‚place a2
.lb2: move.b d0,(a1)+        ; remplit dest
   bra.s .lb1
.lb3:
	rts

   SAUT
loadbin:
	moveq #0,d7
   move.l (a6)+,a3           ; adresse de d‚part
   clr -(sp)                 ; lecture
   move.l (a6)+,-(sp)        ; nom du fichier
   move.l (a6)+,d6           ; size
   bclr #31,d6               ; si c'est -1, alors ‡a devient 2 Go
   move.l (a6),d5            ; start, si start<0, s=-start et allouer s+n octets et charger … partir de s (laissant s octets vides avant)
   								  ; uniquement avec adresse nulle et malloc !
   cmp.l d7,a3
   bne.s .lb0
   clr.l (a6)					  ; retour adresse nul pour l'instant
   subq.l #4,a6				  ; place pour retour code/taille
.lb0:
   GEMDOS 61,8               ; fopen
   move.l d0,d7
   bmi.s .gloups
   cmp.l #0,a3					  ; adresse nulle?
   bne.s .zoneok
   move #2,-(sp)				  ; depuis la fin
   move d7,-(sp)
   clr.l -(sp)
   GEMDOS 66,10				  ; fseek … la fin = taille fichier !
   tst.l d0
   bmi.s .gloups
   tst.l d5						  ; truc n‚gatif?
   bmi.s .lk1
   sub.l d5,d0					  ; max … charger
.lk1:
   cmp.l d0,d6					  ; taille voulue
   bmi.s .tailleok
   move.l d0,d6				  ; taille qui pourra ˆtre lue
   tst.l d5
   bpl.s .tailleok
   sub.l d5,d6					  ; ajouter abs(d5) … d6, taille en plus!
.tailleok:
	move.l d6,-(sp)
	GEMDOS 72,6					  ; malloc
	tst.l d0
	bmi.s .gloups
	move.l d0,a3				  ; zone trouv‚e!
	move.l d0,4(a6)			  ; renvoie l'adresse … l'appelant
	tst.l d5
	bpl.s .zoneok
	add.l d5,d6						; remet d6 … la taille du fichier voulue
	sub.l d5,a3						; d‚cale a3 de abs(d5) pour le chargement
	moveq #0,d5						; puis annule, charger depuis le d‚but
.zoneok:
	bsr _load_segment
.gloups:
   move.l d0,(a6)             ; taille effectivement lue ou code erreur
   tst.l d7
   beq.s .fin						; pas de fichier ouvert
   move d7,-(sp)
   GEMDOS 62,4
.fin:
	rts

	; d7 = handle
	; a3 = zone m‚moire
	; d6 = taille … charger
	; d5 = offset

_load_segment:
   clr -(sp)                 ; au d‚but
   move d7,-(sp)
   move.l d5,-(sp)
   GEMDOS 66,10              ; fseek
   tst.l d0
   bmi.s .gloups
   move.l a3,-(sp)           ; buffer
   move.l d6,-(sp)           ; taille
   move d7,-(sp)
   GEMDOS 63,12              ; fread
.gloups:
	rts

   SAUT
savebin:
   move.l (a6)+,a3           ; adresse de d‚part
   clr -(sp)                 ; attribut normal
   move.l (a6)+,-(sp)        ; nom du fichier
   move.l (a6),d6            ; size
   GEMDOS 60,8               ; fcreate
   move.l d0,d7
   bmi.s .gloups
   move.l a3,-(sp)           ; buffer
   move.l d6,-(sp)           ; taille
   move d7,-(sp)
   GEMDOS 64,12              ; write
   tst.l d0
   bmi.s .gloups
   move.l d0,(a6)            ; taille effectivement ‚crite
   move d7,-(sp)
   GEMDOS 62,4
   tst.l d0
   bmi.s .gloups
   rts
.gloups: move.l d0,(a6)
	rts

   SAUT
addrsto: move control+6(pc),d1
   move.l #addrin,a2
   move d1,d2
   subq #1,d2
   asl #2,d1
   add.w d1,a2
.lb1: move.l (a6)+,-(a2)
   dbf d2,.lb1
   rts

   COPIE aess,y204,1
aess: AES
y204: rts

   COPIE vdii,y205,1
vdii: VDI
y205: rts

   SAUT
ctrl: lea control(pc),a0
   move.l a0,-(a6)
   rts

   COPIE iin,y206,1
iin: move.l #intin,-(a6)
y206: rts

   COPIE pin,y207,1
pin: move.l #ptsin,-(a6)
y207: rts

   COPIE iout,y208,1
iout: move.l #intout,-(a6)
y208: rts

   COPIE pout,y209,1
pout: move.l #ptsout,-(a6)
y209: rts

   COPIE ain,y210,1
ain: move.l #addrin,-(a6)
y210: rts

   COPIE aout,y211,1
aout: move.l #addrout,-(a6)
y211: rts

   COPIE hdl,y212,1
hdl: move.l #handle,-(a6)
y212: rts

   COPIE vctrl,y213,1
vctrl: lea control+12,a0
   move handle,(a0)
   move.l (a6)+,-(a0)
   move.l (a6)+,-(a0)
   move.l (a6)+,-(a0)
   addq.l #2,a6
   move (a6)+,(a0)
y213: rts

   COPIE actrl,y214,1
actrl: lea control+8,a0
   clr (a0)
   move.l (a6)+,-(a0)
   addq.l #2,a6
   move (a6)+,(a0)
   move.l (a6)+,-(a0)
   addq.l #2,a6
   move (a6)+,(a0)
y214: rts

   SAUT
vint: moveq #0,d1
   move control+6(pc),d1
   lea intin,a2
   bra.s spint

   SAUT
ptinsto: moveq #0,d1
   move control+2(pc),d1
   lsl #1,d1
   lea ptsin,a2
   bra.s spint

   SAUT
aint: moveq #0,d1
   move control+2(pc),d1
   lea intin,a2

spint: add.l d1,a2
   add.l d1,a2
   subq #1,d1
.lb1: move.l (a6)+,d2
   move d2,-(a2)
   dbf d1,.lb1
   rts

	SAUT
v_opnvwk:
	tst.l 40(a6)		; le onziŠme paramŠtre est id
	bne.s .externe		; si non nul, ce n'est pas l'‚cran qui est voulu
	XBIOS 4,2			; get_rez
	addq.l #2,d0
	move.l d0,40(a6)  ; id=getrez+2
	ifd LIB
		tst.b aes_flag
		bne.s .aes
		move i_handle,handle		; dans le dossier AUTO, handle physique=i_handle
		bra.s .externe
		.aes:
	endif
	GEM_AES graf_hand
	move intout,handle
.externe:
	moveq #100,d0
ouvrir:
	moveq #0,d1			; pas d'‚l‚ments ptsin
ouvrir2:
	moveq #11,d2
	moveq #0,d3
	bsr vdiun
	move control+12,handle
	rts

	SAUT
vswr_mode:
	V1 32,0,1,0

	SAUT
vs_color:
	V1 14,0,4,0

	SAUT
vq_color:
	V1 26,0,2,0

	SAUT
vst_point:
	V1 107,0,1,0

	SAUT
vst_rotation:
	V1 13,0,1,0

	SAUT
vst_font:
	V1 21,0,1,0

	SAUT
vst_color:
	V1 22,0,1,0

	SAUT
vst_effects:
	V1 106,0,1,0

	SAUT
vst_alignment:
	V1 39,0,2,0

	SAUT
vqt_width:
	V1 117,0,1,0

	SAUT
vqt_name:
	move #130,d0
	moveq #0,d1
	moveq #1,d2
	moveq #0,d3
	bsr vdiun
	lea pad+2,a0
	move.l a0,-(a6)    ; laisse pad sur la pile
	lea intout+2,a1
	moveq #31,d0
.lb0:
	move (a1)+,d1      ; tansvase 32 caractŠres
	move.b d1,(a0)+
	dbf d0,.lb0
	clr.b (a0)         ; termine par un z‚ro.
	rts

	SAUT
vsl_type:
	V1 15,0,1,0

	SAUT
vsl_udsty:
	V1 113,0,1,0

	SAUT
vsl_color:
	V1 17,0,1,0

	SAUT
vsl_ends:
	V1 108,0,2,0

	SAUT
vsm_type:
	V1 18,0,1,0

	SAUT
vsm_color:
	V1 20,0,1,0

	SAUT
vsf_interior:
	V1 23,0,1,0

	SAUT
vsf_style:
	V1 24,0,1,0

	SAUT
vsf_color:
	V1 25,0,1,0

	SAUT
vsf_perimeter:
	V1 104,0,1,0

	SAUT
v_show_c:
	V1 122,0,1,0

; vdi 1: ceux qui ont des paramŠtres intin et ptsin mais sans offset
; d0=opcode,d1=ptsin,d2=intin,d3=subcode

vdiun: lea control(pc),a0
	move d0,(a0)+
	move d1,(a0)+
	move.l d2,(a0)+
	move.l d3,(a0)+
	move handle,(a0)
	if STE=0
		lea (ptsin,d1*4),a0
	else
		lea ptsin,a0
		add.l d1,a0
		add.l d1,a0
		add.l d1,a0
		add.l d1,a0
	endif
	bra.s .lb1
.lb0:
	move.l (a6)+,d0      ; deux coordonn‚es … la fois
	move d0,-(a0)
	move.l (a6)+,d0
	move d0,-(a0)
.lb1:
	dbf d1,.lb0
	if STE=0
		lea (intin,d2*2),a0
	else
		lea intin,a0
		add.l d2,a0
		add.l d2,a0
	endif
	bra.s .lb3
.lb2:
	move.l (a6)+,d0      ; un ‚l‚ment intin … la fois
	move d0,-(a0)
.lb3:
	dbf d2,.lb2
	VDI
	rts

	SAUT
vs_clip:
	tst.l (a6)
	bne.s .lb0
	lea -16(a6),a6       ; simule les 4 coordonn‚es
   bra.s .lb1
.lb0:
	movem.l (a6)+,d0-d4
	move.l d0,d5
	movem.l d1-d5,-(a6)  ; inverse intin et ptsin
.lb1:
	V2 129,2,1,0

	SAUT
v_pline:
	moveq #6,d0
	move.l (a6)+,d1
	moveq #0,d2
	moveq #0,d3
	bra vdideux

	SAUT
v_pmarker:
	moveq #7,d0
	move.l (a6)+,d1
	moveq #0,d2
	moveq #0,d3
	bra vdideux

	SAUT
v_contourfill:
	V2 103,1,1,0

	SAUT
v_recfl:
	V2 114,2,0,0

	SAUT
v_fillarea:
	moveq #9,d0
	move.l (a6)+,d1
	moveq #0,d2
	moveq #0,d3
	bra vdideux

	SAUT
v_bar:
	V2 11,2,0,1

	SAUT
v_rfbox:
	V2 11,2,0,9

	SAUT
v_rbox:
	V2 11,2,0,8

; vdi 2: idem mais avec offset sur tout le tableau ptsin
; d0=opcode,d1=ptsin,d2=intin,d3=subcode

vdideux: lea control(pc),a0
	move d0,(a0)+
	move d1,(a0)+
	move.l d2,(a0)+
	move.l d3,(a0)+
	move handle,(a0)
	move.l fenetre,a0
	move (a0)+,d3        ; offsets du coin de la fenetre
	move (a0),d4
	tst.b xy_flag
	bne.s .off
	moveq #0,d3
	moveq #0,d4          ; sinon, pas d'offset
.off:
	if STE=0
		lea (ptsin,d1*4),a0
	else
		lea ptsin,a0
		add.l d1,a0
		add.l d1,a0
		add.l d1,a0
		add.l d1,a0
	endif
	bra.s .lb1
.lb0:
	move.l (a6)+,d0      ; deux coordonn‚es … la fois
	add d4,d0
	move d0,-(a0)
	move.l (a6)+,d0
	add d3,d0
	move d0,-(a0)
.lb1:
	dbf d1,.lb0
	if STE=0
		lea (intin,d2*2),a0
	else
		lea intin,a0
		add.l d2,a0
		add.l d2,a0
	endif
	bra.s .lb3
.lb2:
	move.l (a6)+,d0      ; un ‚l‚ment intin … la fois
	move d0,-(a0)
.lb3:
	dbf d2,.lb2
	VDI
	rts

	SAUT
v_clsvwk:
	V3 101,0

	SAUT
v_clrwk:
	V3 3,0

	SAUT
vq_key_s:
   V3 128,0

	SAUT
vqt_attributes:
	V3 38,0

	SAUT
vqt_fontinfo:
	V3 131,0

	SAUT
vql_attributes:
	V3 35,0

	SAUT
vqm_attributes:
	V3 36,0

	SAUT
vqf_attributes:
	V3 37,0

	SAUT
v_hide_c:
	V3 123,0

; vdi 3: pas de paramŠtres
; d0=opcode,d3=subcode

vditrois:
	lea control(pc),a0
	move d0,(a0)+
	clr.l (a0)+
	clr.l (a0)+
	move d3,(a0)+
	move handle,(a0)
	VDI
	rts

	SAUT
vq_chcells:
	V4 1
	lea intout,a0
	move.l fenetre,a1
	moveq #0,d0
	move 6(a1),d0      ; H
	divs 14(a1),d0     ; divis‚ par h
	move d0,(a0)+      ; nombre de lignes
	moveq #0,d0
	move 4(a1),d0      ; L
	divs 12(a1),d0     ; divis‚ par l
	move d0,(a0)       ; nombre de colonnes
	rts

	SAUT
v_exit_cur:
	V4 2
	clr.l -(a6)
	bra v_show_c

	SAUT
v_enter_cur:
	V4 3
	bra v_hide_c

	SAUT
v_curup:
	V4 4
	move.l fenetre,a0
	move 14(a0),d0     ; h d'un caractŠre
	sub d0,10(a0)      ; l'ote … la ligne du curseur
	bpl.s .lb0
	clr 10(a0)         ; si <0, on ‚tait d‚j… en haut
.lb0: rts

	SAUT
v_curdown:
	V4 5
	move.l fenetre,a0
	move 10(a0),d0     ; y du curseur
	move 6(a0),d1
	add 14(a0),d0      ; y+h
	sub 14(a0),d1      ; H-h
	cmp d0,d1
	bmi.s .lb0
	move d0,10(a0)     ; modifi‚ si H-h>=y+h
.lb0: rts

	SAUT
v_curright:
	V4 6
	move.l fenetre,a0
	move 8(a0),d0     ; x du curseur
	move 4(a0),d1
	add 12(a0),d0      ; x+l
	sub 12(a0),d1      ; L-l
	cmp d0,d1
	bmi.s .lb0
	move d0,8(a0)     ; modifi‚ si L-l>=x+l
.lb0: rts

	SAUT
v_curleft:
	V4 7
	move.l fenetre,a0
	move 12(a0),d0     ; l d'un caractŠre
	sub d0,8(a0)       ; l'ote … la colonne du curseur
	bpl.s .lb0
	clr 8(a0)          ; si <0, on ‚tait d‚j… … gauche
.lb0: rts

	SAUT
v_curhome:
	V4 8
	if STE=0
		clr.l ([fenetre],8) ; efface x et y
	else
		move.l fenetre,a0
		clr.l 8(a0)
	endif
	rts

	SAUT
v_eeos:
	V4 9
	rts

	SAUT
v_eeol:
	V4 10
	rts

	SAUT
vs_curaddress:
   movem.l (a6)+,d0-d1  ; d0=colonne, d1=ligne
	tst.b xy_flag
	beq.s .vdi
	move.l fenetre,a0
	subq #1,d0
	muls 12(a0),d0       ; x voulu
	move 4(a0),d2
	sub 12(a0),d2        ; L-l
	cmp d0,d2
	bpl.s .lb0           ; ‡a rentre!
	moveq #0,d0
	move 4(a0),d0
	divs 12(a0),d0
	subq #1,d0
	muls 12(a0),d0       ; calcule la colonne maxi
.lb0:
	move d0,8(a0)
	subq #1,d1
	muls 14(a0),d1       ; y voulu
	move 6(a0),d2
	sub 14(a0),d2        ; H-h
	cmp d1,d2
	bpl.s .lb1           ; ‡a rentre!
	moveq #0,d1
	move 6(a0),d1
	divs 14(a0),d1
	subq #1,d1
	muls 14(a0),d1       ; calcule la colonne maxi
.lb1:
	move d1,10(a0)
	rts
.vdi:
	lea control(pc),a0
	move #5,(a0)+
	clr.l (a0)+
	move #2,(a0)+
	move.l #11,(a0)+
	move handle,(a0)
   exg.l d0,d1
   movem.w d0-d1,intin
   VDI
   rts

   SAUT
v_curtext:
	tst.b xy_flag
	bne type
   lea control(pc),a2
   move.l #intin,a3
   move.l (a6)+,a0
   move.l a0,a1
   add.l -4(a0),a1
   move.b (a1),d1
   clr.b (a1)
   clr d0
   clr d3
.lb1: move.b (a0)+,d3
   beq.s .lb2
   addq #1,d0
   move d3,(a3)+
   bra.s .lb1
.lb2: move.b d1,(a1)
   move #5,(a2)+
   clr.l (a2)+
   move d0,(a2)+
   moveq #12,d0
   move.l d0,(a2)+
   move handle,(a2)
   VDI
   rts

   SAUT
v_rvon:
	V4 13
	rts

	SAUT
v_rvoff:
	V4 14
	rts

	SAUT
vq_curaddress:
	V4 15
	lea intout,a1
	move.l fenetre,a0
	moveq #0,d0
	move 10(a0),d0
	divs 14(a0),d0
	addq #1,d0     ; y/h+1, ligne du curseur (1 … maxi)
	move d0,(a1)+
	moveq #0,d0
	move 8(a0),d0
	divs 12(a0),d0
	addq #1,d0     ; x/l+1, colonne
	move d0,(a1)
	rts

	SAUT
vq_tabstatus:
	moveq #16,d0
	bra vdiquatre

	SAUT
v_hardcopy:
	moveq #17,d0
vdiquatre:		; fonctions ESC VDI
   lea control(pc),a0
   move #5,(a0)+
   clr.l (a0)+
   clr.l (a0)+
   move d0,(a0)+
   move handle,(a0)
   VDI
	rts

	SAUT
vex_timv:
	lea control(pc),a0
	move #118,(a0)+
	clr.l (a0)+
	clr.l (a0)+
	clr (a0)+
	move handle,(a0)+
	move.l (a6)+,(a0)
	VDI
	rts

	SAUT
vst_load_fonts:
	lea control(pc),a0
	move #119,(a0)+
	clr.l (a0)+
	move #1,(a0)+
	clr.l (a0)+
	move handle,(a0)
	clr intin
	VDI
	rts

	SAUT
vst_unload_fonts:
	lea control(pc),a0
	move #120,(a0)+
	clr.l (a0)+
	move #1,(a0)+
	clr.l (a0)+
	move handle,(a0)
	clr intin
	VDI
	rts

	SAUT
v_gtext:
	moveq #8,d7
   moveq #0,d6

; d7 contient op code (>0 pour 8 bits et <0 pour 16 bits)
; d6 contient 0 (pas d'offsets) ou 1 (tableau d'offsets pr‚sent

_text:
   move.l (a6)+,a0        ; adresse chaine
   lea intin,a1
	tst d7
	bpl.s	.bit8    			; si >0, c'est un texte 8 bits
	neg d7					; sinon, texte 16 bits
.lb00:
	move (a0)+,(a1)+
	bne.s .lb00
	bra.s .lb01
.bit8:
   moveq #0,d0
.lb0:
	move.b (a0)+,d0
	move d0,(a1)+
	bne.s .lb0
.lb01:
	move.l a1,d0
	sub.l #intin+2,d0
	lsr.l #1,d0            ; nombre de caractŠres
	lea control(pc),a0
	move d7,(a0)+          ; d7 contient 8 (gtext) ou 241 (ftext)
	muls d0,d6				  ; fois 1 ou 0
	addq #1,d6				  ; plus x,y de toutes fa‡ons
	move d6,(a0)+
	move.l d0,(a0)+
	clr.l (a0)+
	move handle,(a0)
	movem.l (a6)+,d0-d1
	exg.l d0,d1
	lea ptsin,a0
	movem.w d0-d1,(a0)
	tst.b xy_flag
	beq.s .fin
	if STE=0
		move.l ([fenetre]),d0
	else
		move.l a0,d1
		move.l fenetre,a0
		move.l (a0),d0
		move.l d1,a0
	endif
	add.l d0,(a0)
.fin:
	cmp #1,d6
	beq.s .vdi				; pas de tableau d'offsets
	move.l (a6)+,a1		; adresse du tableau
	addq.l #4,a0			; vers ptsin+4
	subq #1,d6
	bra.s .lb2
.lb3:
	move.l (a1)+,(a0)+	; couple de x,y
.lb2:
	dbf d6,.lb3
.vdi:
	VDI
	rts

	SAUT
v_justified:
   lea intin,a1
   lea ptsin,a2
   movem.l (a6)+,d0-d2
   move d1,(a1)+   ; inter word
   move d0,(a1)+   ; inter char
   move d2,4(a2)   ; len
   move.l (a6)+,a0
   moveq #0,d0
.lb0:
	move.b (a0)+,d0
	move d0,(a1)+
	bne.s .lb0
	move.l a1,d0
	sub.l #intin+2,d0
	lsr.l #1,d0            ; nombre de caractŠres+2
	lea control(pc),a0
	move #11,(a0)+
	move #2,(a0)+
	move.l d0,(a0)+
	clr.l (a0)+
	move handle,(a0)
	movem.l (a6)+,d0-d1
	exg.l d0,d1
	movem.w d0-d1,(a2)
	tst.b xy_flag
	beq.s .fin
	if STE=0
		move.l ([fenetre]),d0
	else
		move.l fenetre,a1
		move.l (a1),d0
	endif
	add.l d0,(a2)
.fin:
	VDI
	rts

	SAUT
vqt_extent:
   move.l (a6)+,a0        ; adresse chaine
   lea intin,a1
   moveq #0,d0
.lb0:
	move.b (a0)+,d0
	move d0,(a1)+
	bne.s .lb0
	move.l a1,d0
	sub.l #intin+2,d0
	lsr.l #1,d0            ; nombre de caractŠres
	lea control(pc),a0
	move #116,(a0)+
   clr.l (a0)+
	move d0,(a0)+
	clr.l (a0)+
	move handle,(a0)
	VDI
	rts

	SAUT
vst_height:
	lea control(pc),a0
	move #12,(a0)+
	move #1,(a0)+
	clr.l (a0)+
	clr.l (a0)+
	move handle,(a0)
	move.l (a6)+,ptsin    ; hauteur dans ptsin+2
	VDI
	rts

	SAUT
vsl_width:
	lea control(pc),a0
	move #16,(a0)+
	move #1,(a0)+
	clr.l (a0)+
	clr.l (a0)+
	move handle,(a0)
	move.l (a6)+,d0
	swap d0
	move.l d0,ptsin   ; ‚paisseur en ptsin et 0 en ptsin+2
	VDI
	rts

	SAUT
vsm_height:
	lea control(pc),a0
	move #19,(a0)+
	move #1,(a0)+
	clr.l (a0)+
	clr.l (a0)+
	move handle,(a0)
	move.l (a6)+,ptsin    ; hauteur dans ptsin+2
	VDI
	rts

	SAUT
vsf_udpat:
	lea control(pc),a0
	move #112,(a0)+
	clr.l (a0)+
	move.l (a6)+,d0
	move d0,d1
	asl #4,d1
	move d1,(a0)+         ; 16*nombre de plans
	clr.l (a0)+
	move handle,(a0)
	move.l (a6)+,a0
	lea intin,a1
	add d0,d0				 ; 1=32 octets
	bra.s .lb1
.lb0:
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+
.lb1:
	dbf d0,.lb0
	VDI
	rts

	SAUT
v_arc:
	moveq #2,d0
	bra.s arc

	SAUT
v_pieslice:
	moveq #3,d0
arc:
	lea control(pc),a0
	move #11,(a0)+
	move #4,(a0)+
	move.l #2,(a0)+
	move.l d0,(a0)+
	move handle,(a0)
	lea ptsin+14,a0
	clr (a0)
	movem.l (a6)+,d0-d4 ; d0=a1,a0,r,y,x=d4
	move d2,-(a0)
	clr.l -(a0)
	clr.l -(a0)
	move d3,-(a0)
	move d4,-(a0)
	tst.b xy_flag
	beq.s .lb0
	if STE=0
		move.l ([fenetre]),d4
	else
		move.l fenetre,a1
		move.l (a1),d4
	endif
	add.l d4,(a0)
.lb0:
	exg d0,d1
	movem.w d0-d1,intin
	VDI
	rts

	SAUT
v_circle:
	lea control(pc),a0
	move #11,(a0)+
	move #3,(a0)+
	clr.l (a0)+
	move.l #4,(a0)+
	move handle,(a0)
	lea ptsin+10,a0
	clr (a0)
	movem.l (a6)+,d0-d2 ; d0=r,y,x=d2
	move d0,-(a0)
	clr.l -(a0)
	move d1,-(a0)
	move d2,-(a0)
	tst.b xy_flag
	beq.s .lb0
	if STE=0
		move.l ([fenetre]),d0
	else
		move.l fenetre,a1
		move.l (a1),d0
	endif
	add.l d0,(a0)
.lb0:
	VDI
	rts

	SAUT
v_ellarc:
	moveq #6,d0
	bra.s ellarc

	SAUT
v_ellpie:
	moveq #7,d0
ellarc:
	lea control(pc),a0
	move #11,(a0)+
	move #2,(a0)+
	move.l #2,(a0)+
	move.l d0,(a0)+
	move handle,(a0)
	movem.l (a6)+,d0-d5 ; d0=a1,a0,ry,rx,y,x=d5
	lea ptsin,a0
	move d5,(a0)+
	move d4,(a0)+
	move d3,(a0)+
	move d2,(a0)
	tst.b xy_flag
	beq.s .lb0
	if STE=0
		move.l ([fenetre]),d4
	else
		move.l fenetre,a1
		move.l (a1),d4
	endif
	add.l d4,-6(a0)
.lb0:
	exg d0,d1
	movem.w d0-d1,intin
	VDI
	rts

	SAUT
v_ellipse:
	lea control(pc),a0
	move #11,(a0)+
	move #2,(a0)+
	clr.l (a0)+
	move.l #5,(a0)+
	move handle,(a0)
	movem.l (a6)+,d0-d3 ; d0=ry,rx,y,x=d3
	lea ptsin,a0
	move d3,(a0)+
	move d2,(a0)+
	move d1,(a0)+
	move d0,(a0)
	tst.b xy_flag
	beq.s .lb0
	if STE=0
		move.l ([fenetre]),d0
	else
		move.l fenetre,a1
		move.l (a1),d0
	endif
	add.l d0,-6(a0)
.lb0:
	VDI
	rts

	SAUT
vsc_form:
	lea control(pc),a0
	move #111,(a0)+
	clr.l (a0)+
	move #37,(a0)+
	clr.l (a0)+
	move handle,(a0)
	lea intin,a0
	move.l (a6)+,a1
	moveq #8,d0
.lb0:
	move.l (a1)+,(a0)+
	dbf d0,.lb0
	move (a1),(a0)
	VDI
	rts

	SAUT
v_alpha_text:
   bsr _intin_str
   V5 5,0,25

	SAUT
v_bez:
	moveq #6,d0
_bez:	move.l (a6)+,d1	; count
	move.l d1,d2
	moveq #13,d3
	bra vdideux

	SAUT
v_bez_fill:
	moveq #9,d0
   bra.s _bez

	SAUT
v_bez_off:
   V3 11,13

   SAUT
v_bez_on:
	subq.l #8,a6		; simule 2 entiers
	V1 11,1,0,13

	SAUT
v_bez_qual:
	move.l (a6)+,d0
	move.l #32,-(a6)
	move.l #1,-(a6)
	move.l d0,-(a6)
	V1 5,0,3,99

	SAUT
v_bit_image:
	movem.l (a6)+,d0-d3
	exg d0,d3
	exg d1,d2
	movem d0-d3,ptsin
	lea intin+10,a1
	bsr _intin_str2
	addq #5,d2
	movem.l (a6)+,d0-d1/d3-d5
	exg d0,d5
	exg d1,d4
	movem d0-d1/d3-d5,intin
	V5 5,2,23

	SAUT
v_fulshcache:
	V3 251,0

	SAUT
v_fontinit:
	move.l (a6),d0			; header
	swap d0
	move.l d0,(a6)			; le high en word
	swap d0
	move.l d0,-(a6)		; le low en word
	V1 5,0,2,102

	SAUT
v_form_adv:
	V4 20

	SAUT
v_ftext16:
	move #-241,d7
	moveq #0,d6
	bra _text

	SAUT
v_ftext_offset:
	move #241,d7
	moveq #1,d6
	bra _text

	SAUT
v_ftext_offset16:
	move #-241,d7
	moveq #1,d6
	rts

	SAUT
v_getbitmap_info:
	V1 239,0,1,0

	SAUT
v_getoutline:
	V1 243,0,6,0

	SAUT
v_get_pixel:
	V2 105,1,0,0

	SAUT
v_loadcache:
	lea intin,a1
	move.l (a6)+,d0
	move d0,(a1)+
	bsr _intin_str2
	addq #1,d2		; plus le mot de mode
	V5 250,0,0

	SAUT
v_output_window:
	V1 5,2,0,21

	SAUT
v_pgcount:
	V1 5,0,1,2000

	SAUT
v_savecache:
	bsr _intin_str
	V5 249,0,0

	SAUT
v_set_app_buff:
	lea intin,a1
	addq.l #2,a6
	move (a6)+,4(a1)	; nparag
	move (a6)+,(a1)+
	move (a6),(a1)
	moveq #3,d2
	V5 -1,0,6

	SAUT
v_write_meta:
	move.l (a6)+,d1
	move.l (a6)+,d2
	moveq #5,d0
	moveq #99,d3
	bra vdiun

	SAUT
vex_butv:
	move.l (a6)+,control+14
	V3 125,0

	SAUT
vex_curv:
	move.l (a6)+,control+14
	V3 127,0

	SAUT
vex_motv:
	move.l (a6)+,control+14
	V3 126,0

	SAUT
vq_extnd:
	V1 102,0,1,0

	COPIE vq_gdos,vvv
vq_gdos:
	moveq #-2,d0
	trap #2
	move.l d0,-(a6)
vvv: rts

	SAUT
_vq_mouse:
	V3 124,0

	SAUT
vq_scan:
	V4 24

	SAUT
vqt_advance32:
vqt_advance:
	V1 247,0,1,0

	SAUT
vqt_cachesize:
	V1 255,0,1,0

	SAUT
vqt_f_extent16:
	bsr _intin_str16
	V5 240,0,0

	SAUT
vqt_fontheader:
	move #234,d0
	moveq #0,d1
	moveq #0,d2
	moveq #0,d3
	move.l (a6)+,intin
	bsr vdicinq
	lea pad+2,a0
	move.l a0,-(a6)
	lea intout,a1
	moveq #127,d0
.lb0:
	move.b (a1)+,(a0)+
	dbeq d0,.lb0
	clr.b (a0)
	rts

	SAUT
vqt_get_table:
	V3 254,0

	SAUT
vqt_pairkern:
	V1 235,0,2,0

	SAUT
vqt_trackkern:
	V3 234,0

	SAUT
vst_arbpt32:
	V1 246,0,2,0

	SAUT
vst_charmap:
	V1 236,0,1,0

	SAUT
vst_error:
	lea intin,a1
	move.l (a6)+,d0		; le mode
	move d0,(a1)+
	bne.s .lb0
	move.l (a6)+,(a1)		; si nul, il faut l'adresse
.lb0:
	moveq #3,d2
	V5 245,0,0

	SAUT
vst_kern:
	V1 237,0,2,0

	SAUT
vst_scratch:
	V1 244,0,1,0

	SAUT
vst_setsize32:
	V1 252,0,2,0

	SAUT
_wind_create:
	A1 100,5,1,0

	SAUT
_wind_open:
	A1 101,5,1,0

	SAUT
_wind_close:
	A1 102,1,1,0

	SAUT
wind_delete:
	A1 103,1,1,0

	SAUT
_wind_set:
	movem.l (a6)+,d0-d1   ; d0=flag
	cmp #1,d0             ; mot de d‚finition
	bne.s .lb0
.lb1:
	move.l d0,-(a6)       ; flag
	move.l d1,-(a6)       ; param 1
.lb5:
	lea -12(a6),a6        ; param2 … 4 fictifs
.aes:
	A1 105,6,1,0
.lb0:
	cmp #8,d0             ; position
	beq.s .lb1
	cmp #9,d0             ; position
	beq.s .lb1
	cmp #15,d0            ; taille
	beq.s .lb1
	cmp #16,d0            ; taille
	beq.s .lb1
	cmp #2,d0             ; titre
	bne.s .lb2
.lb3:
	move.l d0,-(a6)       ; flag
	swap d1
	move d1,-(a6)         ; high de l'adresse (param1)
	clr -(a6)
	swap d1
	move d1,-(a6)         ; low de l'adresse (param2)
	lea -10(a6),a6        ; param3 et 4 fictifs
	bra .aes
.lb2:
	cmp #3,d0             ; info
	beq.s .lb3
   cmp #10,d0            ; activer
   bne.s .lb4
	subq.l #8,a6          ; revient dur hdl et flg
	move.l d1,-(a6)       ; param1=hdl
	bra .lb5              ; autres paramŠtres
.lb4:
	cmp #14,d0            ; fond du bureau
	bne.s .lb6            ; vers autre mode
	moveq #0,d2
	moveq #0,d3
	move (a6)+,d2         ; high adr
	move (a6)+,d3         ; low adr
	clr.l -(a6)           ; hdl fictif
	move.l d0,-(a6)       ; flag
	move.l d2,-(a6)       ; param1
	move.l d3,-(a6)       ; param2
	move.l d1,-(a6)       ; param3
	clr.l -(a6)           ; param4 fictif
	bra .aes
.lb6:
	movem.l (a6)+,d2-d4
	move.l d0,d5
	movem.l d1-d5,-(a6)
	bra .aes

	SAUT
wind_get:
	A1 104,2,5,0

	SAUT
wind_find:
	A1 106,2,1,0

	SAUT
_wind_update:
	A1 107,1,1,0

	SAUT
_wind_calc:
	bclr #1,23(a6)			; flag +2 for center facility !
	sne d5
	bsr.s .calc
	tst.b d5
	beq.s .out
	movem.w maxi_xylh,d0-d3	; taille fenˆtre 0
	movem.w intout+6,d4-d5  ; w,h fenetre en cours
	sub d4,d2
	sub d5,d3
	lsr #1,d2
	lsr #1,d3
	add d2,d0				; x centr‚ = x0 + (w0-w)/2
	add d3,d1				; y centr‚ = y0+ (h0-h)/2
	movem.w d0-d1,intout+2
.out:
	rts
.calc:
	A1 108,6,5,0

   SAUT
menu_bar:
	A1 30,1,1,1

	SAUT
menu_icheck:
	A1 31,2,1,1

	SAUT
menu_ienable:
	A1 32,2,1,1

	SAUT
menu_tnormal:
	A1 33,2,1,1

	SAUT
menu_register:
	ifd LIB
		tst.b acc_reg
		beq.s .lb0			; enregistrement non fait
		moveq #-1,d0
		cmp.l 4(a6),d0
		beq.s .lb0		; flag=-1 donc appel sous multitos, on le r‚alise
		move acc_id,intout	; sinon, appel r‚alis‚ pour accessoire et renvoie ID
		rts
	.lb0:
	endif
	A1 35,1,1,1

	SAUT
menu_text:
	A1 34,1,1,2

	SAUT
evnt_button:
	A1 21,3,5,0

	SAUT
evnt_mouse:
	A1 22,5,5,0

	SAUT
evnt_timer:
	move.l (a6),d0			; ici laisse LOW en place
	swap d0					; ramŠne HIGH
	move.l d0,-(a6)		; et met HIGh en place
	A1 24,2,1,0

	SAUT
evnt_dclick:
	A1 26,2,1,0

	SAUT
evnt_mesag:
	A1 23,0,1,1

	SAUT
evnt_multi:
	movem.l (a6),d0-d1  ; d0=adr, d1=temps
	swap d1
	move.l d1,(a6)      ; high du temps
	move.l d0,-(a6)  	  ; adr
	A1 25,16,7,1

	SAUT
appl_read:
	A1 11,2,1,1

	SAUT
appl_write:
	A1 12,2,1,1

	SAUT
rsrc_load:
	A1 110,0,1,1

	SAUT
rsrc_gaddr:
	moveq #112,d0
	moveq #2,d1
	moveq #1,d2
	moveq #0,d3
	moveq #1,d4
	bra _aesun

	SAUT
rsrc_saddr:
	A1 113,2,1,1

	SAUT
form_center:
	A1 54,0,5,1

	SAUT
form_dial:
	A1 51,9,1,0

	SAUT
form_do:
	A1 50,1,1,1

	SAUT
objc_draw:
	A1 42,6,1,1

	SAUT
objc_find:
	A1 43,4,1,1

	SAUT
objc_offset:
	A1 44,1,3,1

	SAUT
objc_edit:
	A1 46,4,2,1

	SAUT
objc_change:
	A1 47,8,1,1

	SAUT
graf_rubberbox:
	A1 70,4,3,0

	SAUT
graf_dragbox:
	A1 71,8,3,0

	SAUT
graf_movebox:
	A1 72,6,1,0

	SAUT
graf_growbox:
	A1 73,8,1,0

	SAUT
graf_shrinkbox:
	A1 74,8,1,0

	SAUT
graf_watchbox:
	A1 75,4,1,1

	SAUT
graf_slidebox:
	A1 76,3,1,1

	SAUT
form_alert:
	A1 52,1,1,1

	SAUT
form_error:
	A1 53,1,1,0

	SAUT
fsel_input:
	A1 90,0,2,2

	SAUT
graf_mouse:
   tst (a6)           ; parite haute du paramŠtre
   beq.s .lb0         ; si 0, c'est un code pas une adresse
   move.l (a6),-(a6)  ; d‚place l'adresse
   move.l #255,4(a6)  ; code pour d‚finir la souris
   bra.s .lb1
.lb0:
   clr.l -(a6)        ; adresse nulle
.lb1:
	A1 78,1,1,1

	SAUT
scrp_write:
	A1 81,0,1,1

	SAUT
scrp_read:
	A1 80,0,1,1

	SAUT
shel_get:
	A1 122,1,1,1

	SAUT
shel_put:
	A1 123,1,1,1

	SAUT
shel_envrn:
	A1 125,0,1,2

	SAUT
shel_write:
	A1 121,3,1,2

	SAUT
shel_read:
	A1 120,0,1,2

	SAUT
shel_find:
	A1 124,0,1,1

; d0=code, d1=intin, d2=intout, d3=addrin, d4=addrout (si _aesun, 0 sinon)

aesun:
   moveq #0,d4
_aesun:
   movem.w d0-d4,control
   if STE=0
   	lea (addrin,d3.w*4),a0
   else
      lea addrin,a0
      add d3,a0
      add d3,a0
      add d3,a0
      add d3,a0
   endif
   bra.s .lb1
.lb0:
	move.l (a6)+,-(a0)   ; les ‚l‚ments de addrin
.lb1:
	dbf d3,.lb0
	if STE=0
		lea (intin,d1.w*2),a0
	else
		lea intin,a0
		add d1,a0
		add d1,a0
	endif
	bra.s .lb3
.lb2:
	move.l (a6)+,d0      ; les ‚l‚ments de intin
	move d0,-(a0)
.lb3:
	dbf d1,.lb2
   AES
   rts

	COPIE _appl_init,w1,1
_appl_init:
	move appl_id,intout
w1: rts

	SAUT
graf_handle:
	A2 77,5

	SAUT
evnt_keybd:
	A2 20,1

	SAUT
graf_mkstate:
	A2 79,5

	SAUT
rsrc_free:
	A2 111,1

; d0=code, d2=intout, pas de paramŠtres

aesdeux:
   moveq #0,d1
   moveq #0,d3
   moveq #0,d4
   movem.w d0-d4,control
   AES
   rts

   SAUT
vdisto: lea control(pc),a0
   move (a0)+,d2            ; code fonction
   move (a0)+,d1            ; points de ptsin
   move.l #ptsin,a2
   if STE=0
	   lea 0(a2,d1.w*4),a2
	else
		add d1,a2
		add d1,a2
		add d1,a2
		add d1,a2
	endif
   moveq #0,d0              ; pas d'offset
   tst.b xy_flag
   beq.s .absolu
   cmp #19,d2
   beq.s .absolu
   cmp #12,d2
   beq.s .absolu            ; les fonctions 12 et 19 sans offset
   move.l fenetre,a1
   move.l (a1),d0           ; X et Y dans les deux mots
   cmp #11,d2
   bne.s .k1                ; c'est forc‚ment du relatif
   move 6(a0),d2            ; sous fonction
   cmp #10,d2
   beq.s .absolu            ; en fait, relatif que sur les deux premiers
   cmp #2,d2
   bmi.s .abs0
   cmp #8,d2
   bpl.s .abs0
   bra.s .absolu            ; en fait, relatif pour les 2 premiers
.k0: move.l (a6)+,d2
   move d2,-(a2)
   move.l (a6)+,d2
   move d2,-(a2)
   add.l d0,(a2)            ; ajoute l'offset
.k1:
   dbf d1,.k0
   bra.s .k3
.abs0: moveq #0,d0
.absolu:
   asl #1,d1
   bra.s .lb2
.lb1: move.l (a6)+,d2
   move d2,-(a2)
.lb2: dbf d1,.lb1
   add.l d0,(a2)
.k3:
   move 2(a0),d1
   move.l #intin,a2
   if STE=0
   	lea 0(a2,d1.w*2),a2
   else
   	add d1,a2
   	add d1,a2
   endif
   bra.s .lb4
.lb3: move.l (a6)+,d2
   move d2,-(a2)
.lb4: dbf d1,.lb3
   VDI
   rts

   SAUT
aessto: move control+6(pc),d1
   move.l #addrin,a2
	if STE=0
	   lea 0(a2,d1.w*4),a2
	else
		add d1,a2
		add d1,a2
		add d1,a2
		add d1,a2
	endif
   bra.s .lb2
.lb1: move.l (a6)+,-(a2)
.lb2: dbf d1,.lb1
   move control+2(pc),d1
   move.l #intin,a2
	if STE=0
	   lea 0(a2,d1.w*2),a2
	else
		add d1,a2
		add d1,a2
	endif
   bra.s .lb4
.lb3: move.l (a6)+,d2
   move d2,-(a2)
.lb4: dbf d1,.lb3
   AES
   rts

   SAUT
ltype: move.l (a6)+,a3
.lb0: move #0,-(sp)
   BIOS 8,4
   tst.l d0
   bne.s .lb1
   ACONTROL 52,1,1,1
   move #2,intin
   move.l #avert1,addrin
   AES
   move intout,d0
   cmp #2,d0
   beq.s .lb0
   rts
.lb1: moveq #0,d5
.lb2: move.b (a3)+,d5
   beq.s .lb3
   move.l d5,-(sp) ; remplace move.w et clr.w -(sp)
   BIOS 3,6
   bra.s .lb2
.lb3: rts

   SAUT
defp: move.l (a6)+,a3
	lea 16(a3),a3				 ; pointe sur le d‚coupage col,ligne
	move.l #$10001,(a3)
   move.l fenetre0+12,-(a3) ; hauteur et largeur d'un caractŠre
   clr.l -(a3)              ; curseur … z‚ro
   move.l (a6)+,d0
   move d0,-(a3)            ; H
   move.l (a6)+,d0
   move d0,-(a3)            ; L
   move.l (a6)+,d0
   move d0,-(a3)            ; Y
   move.l (a6)+,d0
   move d0,-(a3)            ; X
   rts

   SAUT
setp: move.l (a6)+,a0
	lea thread0,a1				; par defaut, le mode direct
	move.l thptr,d0
	beq.s .lb0					; pas de thread en cours...
	move.l d0,a1
.lb0:
	move.l a0,42(a1)			; actualise la page du thread
_setp:
   move.l a0,fenetre
   move.l (a0)+,d0
   lea c_pts,a1
   move.l d0,(a1)+
   add.l (a0),d0
   sub.l #$10001,d0
   move.l d0,(a1)+
   GEM_VDI clip_tab
   rts

; col li page setsubpage
	COPIE setsubpage,y233a
setsubpage:
	move.l (a6)+,a3	; page
	move.l (a6)+,d0	; lignes
	lea 18(a3),a3
	move d0,(a3)		; stocke lignes
	move.l (a6)+,d0
	move d0,-(a3)		; stocke colonnes
y233a: rts

; i page getsubpage
	SAUT
getsubpage:
	move.l (a6)+,a3	; page
	move.l (a6)+,d7	; num‚ro de zone
	movem.w (a3),d0-d3	; x,y,l,h
	movem.w 16(a3),d4-d5	; col,ligne
	move d4,d6
	muls d5,d6
	bne.s .lb0
	moveq #1,d4			; si d4 ou d5 nul, remettre 1 par d‚faut
	moveq #1,d5			; (1 colonne, 1 ligne)
	moveq #1,d6
.lb0:
	cmp.l d7,d6			; zone demand‚e au-del… du cadre?
	bgt.s .lb1
	moveq #0,d7			; si oui, zone z‚ro
.lb1:
	divs d4,d7			; xi, yi dans la grille
	divs d4,d2			; l/col = largeur d'une zone
	divs d5,d3			; h/lignes = hauteur d'une zone
	ext.l d2
	ext.l d3
	move.l d3,d6
	muls d7,d6			; hauteur*yi
	add.l d6,d1			; y+hauteur*yi
	move.l d2,d6
	swap d7
	muls d7,d6			; largeur*xi
	add.l d6,d0			; x+largeur*xi
	move.l margin(pc),d6
	add.l d6,d0			; x+m
	add.l d6,d1			; y+m
	add.l d6,d6
	sub.l d6,d2			; l-2m
	sub.l d6,d3			; h-2m
	move.l d0,-(a6)	; x
	move.l d1,-(a6)	; y
	move.l d2,-(a6)	; l
	move.l d3,-(a6)	; h
	rts

	COPIE setmargin,y234,1
setmargin:
	move.l (a6)+,margin
y234:	rts
margin: dc.l 0

   COPIE absolute,y223,1
absolute: sf xy_flag
y223: rts

   SAUT
desk:
	GEM_VDI show_mouse
	move.l menu_adresse,-(a6)
	bsr setmenu
	moveq #1,d0
	move.l d0,-(a6)
	move.l menu_adresse,-(a6)
	bsr menu_bar
.lb0:
	GEM_AES event_mesag
   lea vt_int,a0        ; la o— sont les donn‚es du message
   move (a0),d0         ; le type de message
   cmp #21,d0
   bne.s .k0
   	move 6(a0),d0
   	cmp w_hand,d0
   	bne.s .lb0        ; pas notre fenetre
   	bra .fin          ; on ressort
.k0:
   cmp #27,d0
   beq.s .k1
   cmp #28,d0
   bne.s .k2
.k1:
      move 6(a0),d0
      cmp w_hand,d0
      bne.s .lb0        ; pas notre fenetre
      addq.l #8,a0
      bsr taille_verif  ; (a0) modifi‚ si necessaire (xylh)
      lea ws_int+2,a1
      move #5,(a1)+       ; redessine la fenetre
      move.l (a0)+,(a1)+
      move.l (a0),(a1)+
      GEM_AES wind_set
      move w_hand,wg_int
      GEM_AES wind_get1
      move.l #fenetre0,a1 ; si ‡a bouge, on remet la page 0, c'est plus sur
		move.l a1,-(a6)
      lea w_travail+2,a0
      move.l (a0)+,(a1)+
      move.l (a0),(a1)+
      clr.l (a1)          ; curseur Home
      bsr setp            ; fixe la nouvelle page, avec clipping
      bra .lb0
.k2:
   cmp #20,d0             ; redraw ?
   bne.s .k3
      move w_hand,d0
      cmp 6(a0),d0       ; notre fenetre?
      bne .lb0           ; ben non..
      lea 8(a0),a0       ; pointe sur x,y,l,h … redessiner
      bsr redraw         ; avec d0= handle!
      bra .lb0
.k3:
   cmp #10,d0             ; menu s‚lectionn‚ ?
   bne .lb0
.fin:
  	move #10,ws_int+2 ; wind topped
  	GEM_AES wind_set
   GEM_VDI hide_mouse
   move.l #3,-(a6)			; titre
   move.l #1,-(a6)			; en vid‚o normale
   move.l menu_adresse,-(a6)
   bsr menu_tnormal			; titre en blanc
   clr.l -(a6)					; annule la barre de menu
   move.l menu_adresse,-(a6)
   bsr menu_bar
   move.l fenetre,-(a6)
   bsr setp
	bsr cls
	ifnd LIB
		jsr souris_visible
	endif
   rts

; a0 pointe sur xylh voulus
; fenetre0 contient lh d'un caractŠre ( mini 23 * 5 caractŠres )
; maxi_xylh contient la taille de la fenetre 0


taille_verif:
   move.l a0,-(sp)
   lea fenetre0+12,a0
   moveq #30,d0
   muls (a0)+,d0      ; largeur ( 23 caractŠres )
   moveq #5,d1
   muls (a0),d1       ; hauteur ( 5 lignes )
   lea vt_int+16,a0
   clr (a0)+          ; travail -> esp total
   move wind_mask,(a0)+
   clr.l (a0)+        ; x et y on s'en fout
   move d0,(a0)+
   move d1,(a0)       ; l et h int‚rieurs voulus
   GEM_AES wind_calc
   lea vt_int+34,a1   ; r‚cupŠre les donn‚es ( l et h )
   move.l (sp)+,a0
   move.w (a0)+,d0    ; x voulu
   move (a0)+,d1      ; y
   move (a0)+,d2      ; l
   move (a0),d3       ; h
   cmp (a1),d2        ; longueur suffisante?
   bpl.s .lb0
   move (a1),d2       ; non, alors on prend le minimum
.lb0:
	addq.l #2,a1
	cmp (a1),d3        ; hauteur suffisante ?
	bpl.s .lb1
	move (a1),d3       ; non, on prend le minimum
.lb1:
   lea maxi_xylh,a1
   cmp (a1),d0        ; pas trop … gauche de l'‚cran ?
   bpl.s .k0
   move (a1),d0       ; … droite
.k0:
	cmp 2(a1),d1       ; pas au dessus de l'‚cran ?
	bpl.s .k1
	move 2(a1),d1      ; redescend
.k1:
   cmp 4(a1),d2       ; longueur sup‚rieure … l'‚cran ?
   bmi.s .lb2
   move 4(a1),d2      ; oui!, on r‚tr‚cit alors.
.lb2:
   cmp 6(a1),d3       ; hauteur sup‚rieure … l'‚cran ?
   bmi.s .lb3
   move 6(a1),d3      ; oui, on r‚tr‚cit.
.lb3:
   move d3,(a0)       ; la hauteur est maintenant ok
   move d2,-(a0)      ; la largeur aussi
   neg d2
   neg d3
   add (a1)+,d2
   add (a1)+,d3
   add (a1)+,d2       ; X + L - l
   add (a1),d3        ; Y + H - h
   cmp d3,d1          ; y pas trop bas ?
   bmi.s .lb4
   move d3,d1         ; si, on le remonte
.lb4:
   cmp d2,d0          ; x pas trop … droite ?
   bmi.s .lb5
   move d2,d0         ; si, on recale … gauche
.lb5:
   move d1,-(a0)      ; y parfait
   move d0,-(a0)      ; x fabuleux
   rts

; d0 contient le handle de la fenetre
; a0 pointe sur xylh … reconstituer

redraw:
   move.l (a0)+,d6    ; x et y
   move.l (a0),d7     ; l et h
   add.l d6,d7
   sub.l #$10001,d7   ; d7 contient x+l-1 et y+h-1
   lea wg_int,a3
   move.l (a3),-(sp)  ; sauvegarde les anciennes donn‚es
   move d0,(a3)+      ; le handle
   move #11,(a3)      ; premier rectangle
      GEM_VDI hide_mouse
      move #1,wu_int
      GEM_AES wind_update
   GEM_AES wind_get0
   move #12,(a3)      ; pour le rectangle suivant
.boucle:
   lea wg_out+2,a0    ; le rectangle
   move.l (a0)+,d0    ; x et y
   move.l (a0),d1     ; l et h
   beq .fin           ; se termine si l et h sont nuls
   add.l d0,d1
   sub.l #$10001,d1   ; d1 contient les coordonn‚es du point inf‚rieur
   cmp d6,d0
   bpl.s .k0
   move d6,d0         ; d0 contient le max de y1 et y2
.k0:
   swap d6
   swap d0
   cmp d6,d0
   bpl.s .k1
   move d6,d0         ; d0 contient le max de x1 et x2
.k1:
   swap d6
   swap d0
   cmp d7,d1
   bmi.s .k2
   move d7,d1         ; le plus petit de y1' et y2'
.k2:
   swap d7
   swap d1
   cmp d7,d1
   bmi.s .k3
   move d7,d1         ; le plus petit de x1' et x2'
.k3:
   swap d7
   swap d1
   cmp d1,d0
   bpl .pas_inter
   cmp.l d1,d0
   bpl .pas_inter
   lea copy_pts,a0
   move.l d0,(a0)+
   move.l d1,(a0)     ; coordonn‚es du rectangle
   lea c_pts,a0
   move.l d0,(a0)+
   move.l d1,(a0)     ; pour le clipping
   GEM_VDI clip_tab
   GEM_VDI fill_rect  ; efface la zone
.pas_inter:
   GEM_AES wind_get0  ; rectangle suivant
   bra .boucle
.fin:
      clr wu_int
      GEM_AES wind_update
      GEM_VDI show_mouse
   move.l (sp)+,wg_int ; restaure
   rts

   SAUT
fastop: tst.b w_flag
   bne.s .lb0            ; d‚j… ouvert
   bsr fastopen
.lb0:
	moveq #0,d0
	move w_hand,d0
	move.l d0,-(a6)       ; renvoit le handle
   rts


   COPIE relative,y215,1
relative: st xy_flag
y215:
   rts

   SAUT
fastcl: tst.b w_flag
   beq.s .lb0            ; d‚j… ferm‚
   bsr fastclose
.lb0:
	ifd LIB
		tst.b aes_flag
		bne.s .lb1				 ; aes install‚, pas de fermeture VDI
		bsr ferme_vdi
		move #-1,i_handle
		.lb1:
	endif
   rts

   COPIE page0,y216,1
page0: move.l #fenetre0,-(a6)
y216: rts


separe: dc.b "--------------------"
nulle: dc.b 0

 even
menudat:
 dc.w 0,40,40,40,40,0,40,40,0,36
 dc.w 0,1,0,0,0,0,0,0                   ; nombre d'objets , ... , taille totale

 dc.w -1,1,3,25,0,0,0,0,0,0,0,0         ; ROOT
 dc.w 3,2,2,20,0,0,0,$1100,0,0,0,0      ; BAR
 dc.w 1,3,3,25,0,0,0,0,0,0,0,0          ; ACTIVE

 dc.w 0,0,0,25,0,0,0,0,0,0,0,0          ; SCREEN

isfirst: dc.w 0

   SAUT
menu: move.l #indextab,indexadr   ; pour la table de conversion
  movem.l a4-a6,-(a7)
  move.l #fenetre0+12,a0
  move.w (a0)+,d0       ; largeur cellule
  move.w (a0),d1        ; hauteur cellule
  move.l #work_out,a0
  move.w (a0)+,d2     ; resolution horizontale
  addq #1,d2
  move.w (a0),d3      ; resolution verticale
  addq #1,d3
  move.l #menudat,a0
  move.l topprg,a1
  move.l a1,global+14   ; adresse du header
  rept 5
  move.l (a0)+,(a1)+
  endr
  move.l a1,a5          ; garde l'adresse du nombre d'objets
  rept 4
  move.l (a0)+,(a1)+
  endr
  move.l a1,global+10   ; adresse de la table
  addq.l #4,a1
  move.l a1,-4(a1)      ; table des arbres, un seul qui pointe sur la suite
  move.l (a6),a4        ; adresse des chaines
  move.l a1,(a6)        ; adresse de l'arbre sur la pile
  move.w d2,20(a0)      ; L de ROOT
  move.w d3,22(a0)      ; H
  move.w d2,44(a0)      ; L de BAR
  move.w d2,92(a0)      ; L de SCREEN
  sub.w d1,d3
  sub.w d1,d3
  move.w d3,94(a0)      ; H de SCREEN ( ymax-2lignes )
  moveq #2,d2
  add d1,d2             ; hauteur de BAR
  move d2,46(a0)
  addq #1,d2            ; hauteur des titres
  move d2,70(a0)        ; hauteur de ACTIVE
  move d2,90(a0)        ; y de SCREEN
  move d0,d3
  add d0,d3
  move d3,64(a0)        ; x de ACTIVE

  move.l a1,a6          ; garde le debut de l'arbre
  moveq #17,d4
.lb0: move.l (a0)+,(a1)+
  dbf d4,.lb0           ; transvase ROOT, BAR, ACTIVE

  move -2(a4),d4      ; mlen
  addq #4,d4
  bclr #0,d4            ; d4=offset pour chaine suivante
  moveq #3,d5           ; num‚ro de l'objet libre
  moveq #0,d6           ; largeur de ACTIVE, et x du titre en cours

.titreloop:
  move.l indexadr,a2
  move.b d5,(a2)+       ; table de conversion
  move.l a2,indexadr
  tst.b (a4)
  beq.s .dropdown       ; chaine vide = fin des titres
  move.l a4,a2
.lb1: tst.b (a2)+
  bne.s .lb1
  sub.l a4,a2
  subq.l #1,a2          ; longueur du titre
  move a2,d7            ; L en caractŠres
  muls d0,d7            ; L en points

         ; objet titre

  addq #1,d5            ; un objet de plus
  move d5,(a1)+         ; pointe sur le suivant
  move.l #-1,(a1)+      ; pas d'enfants
  move #32,(a1)+        ; G_TITLE
  clr.l (a1)+           ; flag et state
  move.l a4,(a1)+       ; adr chaine
  move d6,(a1)+         ; X
  clr (a1)+             ; Y
  move d7,(a1)+         ; L
  move d2,(a1)+         ; H

  add d7,d6             ; ACTIVE s'‚largit
  add.w d4,a4           ; chaine suivante
  bra.s .titreloop

.dropdown: move #1,isfirst  ; c'est le premier drop down
  move d6,68(a6)        ; L de ACTIVE
  move d5,24(a6)        ; BAR pointe sur SCREEN
  move d5,4(a6)         ; ROOT pointe sur SCREEN
  subq #1,d5
  move d5,52(a6)        ; ACTIVE pointe sur le dernier titre
  addq #1,d5
  move #2,-24(a1)       ; le dernier titre pointe sur ACTIVE
  lea 72(a6),a3         ; a3 pointe sur la suite des titres

        ; objet SCREEN

  addq #1,d5
  move d5,2(a0)         ; SCREEN pointe sur son premier enfant
  moveq #5,d6
.lb2: move.l (a0)+,(a1)+
  dbf d6,.lb2
  moveq #20,d7          ; premier BOX, large de 20 au minimum

        ; objet drop-down

  move.l a1,a6          ; conserve l'adresse du drop-down

.loopbox: addq #1,d5
  clr (a1)+             ; suivant inconnu
  move d5,(a1)+         ; 1ø enfant
  clr (a1)+             ; dernier inconnu
  move #20,(a1)+        ; G_BOX
  clr.l (a1)+           ; flag et state
  move.l #$FF1100,(a1)+ ; obspec
  move 16(a3),d6        ; x du titre
  add d0,d6
  add d0,d6             ; plus deux colonnes de d‚calage
  move d6,(a1)+         ; x du BOX
  clr (a1)+             ; y
  clr.l (a1)+           ; l et h inconnus

  moveq #0,d3           ; hauteur du BOX

.loopstr:
  move.l indexadr,a2
  move.b d5,(a2)+       ; table de conversion
  move.l a2,indexadr
  add.w d4,a4   ; chaine suivante
  tst.b (a4)
  beq.s .finboite       ; chaine nulle pour la fin d'un DROP-DOWN
  move.l a4,a2
.lb3: tst.b (a2)+
  bne.s .lb3
  sub.l a4,a2
  subq.l #1,a2
  cmp a2,d7             ; compare avec taille maxi
  bpl.s .lb4
  move a2,d7            ; ‚change si plus
.lb4:
       ; objet STRING

  addq #1,d5
  move d5,(a1)+         ; pointe sur suivant
  move.l #-1,(a1)+      ; pas d'enfants
  move #28,(a1)+        ; G_STRING
  clr.l (a1)+           ; flag et state
  move.l a4,(a1)+       ; chaine
  clr (a1)+             ; x
  move d3,(a1)+         ; y
  clr (a1)+             ; l inconnu
  move d1,(a1)+         ; h=1 caractŠre

  add d1,d3             ; BOX augmente de taille
  bra.s .loopstr        ; entr‚e suivante

.finboite: muls d0,d7   ; largeur BOX
  tst isfirst  ; est-ce le premier menu?
  beq.s .autre ; 0 si c'est un autre

        ; objet separateur

  addq #1,d5
  move d5,(a1)+
  move.l #-1,(a1)+
  move #28,(a1)+
  move.l #8,(a1)+
  move.l #separe,(a1)+
  clr (a1)+
  move d3,(a1)+
  add d1,d3
  clr (a1)+
  move d1,(a1)+

       ; les accessoires

  moveq #5,d6
.loopacc: addq #1,d5
  move d5,(a1)+
  move.l #-1,(a1)+
  move #28,(a1)+
  clr.l (a1)+
  move.l #nulle,(a1)+
  clr (a1)+
  move d3,(a1)+
  add d1,d3
  clr (a1)+
  move d1,(a1)+
  dbf d6,.loopacc

  clr isfirst

.autre: move d5,(a6)   ; lie les drop downs
  subq #1,d5
  move d5,4(a6)        ; BOX pointe sur le dernier enfant
  addq #1,d5
  move 24(a6),d6       ; sur qui pointe le premier enfant...
  subq #2,d6           ; ... donc -2 = index du BOX
  move d6,-24(a1)      ; le dernier enfant pointe sur BOX
  move d3,22(a6)       ; H du BOX
.lb5: move d7,20(a6)   ; L du BOX et des STRINGs
  add.w #24,a6         ; objet suivant
  cmp.l a6,a1          ; fini?
  bne.s .lb5           ; ben non

  cmp #2,(a3)
  beq.s .fin           ; c'‚tait le dernier titre ( il pointe sur ACTIVE )
  add.w #24,a3         ; titre suivant
  clr d7               ; largeur du BOX
  bra .loopbox

.fin: move d5,(a5)     ; nombre d'objets dans header
  move d5,d3
  muls #24,d3
  add.w #40,d3         ; taille totale
  move d3,14(a5)       ; dans header
  move d3,global+18

  move.l a1,topprg     ; actualise le dicco
  add.w #24,a3         ; aprŠs les titres on pointe sur SCREEN !
  move d5,d3

.lb6: sub.w #24,a1     ; objet pr‚c‚dent
  subq #1,d3
  cmp (a1),d5
  bne.s .lb6           ; lorqu'il pointera sur d5, ce sera le dernier dropdown

  move d3,4(a3)        ; SCREEN pointe sur son dernier enfant
  move 2(a3),d3        ; sur qui pointe SCREEN...
  subq #1,d3           ; ...donc - 1 c'est son index
  move d3,(a1)         ; le dernier BOX pointe sur SCREEN.

  move.l topprg,a1
  move.l a1,global+6   ; adresse de la table de conversion
  move.l #indextab,a0
  move.l indexadr,d0

.lb7: move (a0)+,(a1)+
  cmp.l d0,a0
  bmi.s .lb7           ; transvase la table de conversion
  move #127,(a1)+       ; pour fin de table
  move.l a1,topprg
  movem.l (sp)+,a4-a6
  rts

   COPIE setmenu,y217,1
setmenu: lea global+6,a0
  move.l (a6)+,a1
  lea -4(a1),a2        ; adresse de la table des arbres
  sub.w #40,a1         ; adresse du header
  move 34(a1),d0       ; taille.w
  move.l a1,a3
  add.w d0,a3          ; debut de la table de conversion
  move.l a3,(a0)+
  move.l a2,(a0)+
  move.l a1,(a0)+
  move d0,(a0)
y217: rts

   COPIE gemindex,y218,1
gemindex: move.l (a6),d0
  move.l global+6,a0
  move.b (a0,d0),3(a6)
y218: rts

   COPIE strindex,y219,1
strindex: move.l (a6),d0
  move.l global+6,a0
  lea 1(a0),a2
.lb0: cmp.b (a0)+,d0
  beq.s .fin
  bpl.s .lb0
.fin: sub.l a2,a0
  move.l a0,(a6)
y219: rts

obdata: dc.l 0
obptr:  dc.l 0
tedata: dc.l 0
imagedat: dc.l 0
obindex: dc.w 0
pereindex: dc.w 0
pereadr: dc.l 0
large: dc.w 1
haut: dc.w 1

; //// ces fonctions appel‚es par gemlist
; //// attention … l'usage des registres
; //// tous ne sont pas sauv‚s par gemlist
; ////


   SAUT
dialogue:
   bsr.s _char_info
   move.l d7,large
   move.l (a6)+,imagedat
   move.l (a6)+,tedata
   move.l (a6),obdata
   move.l (a6)+,obptr
   clr obindex
   rts

_char_info:
	VCONTROL 38,0,0,0
   VDI
   move.l ptsout+4,d7
   rts

   COPIE lastobj,y220,1
lastobj: move.l obptr,a0
   or.w #32,-16(a0)
y220: rts

   COPIE child,y221,1
child: move.l (a6)+,d0
   move d0,pereindex
   muls #24,d0
   move.l obdata,a0
   lea 2(a0,d0),a0
   move obindex,(a0)+
   move.l a0,pereadr
y221: rts

   COPIE parent,y222,1
parent: move.l obptr,a0
   move pereindex,-24(a0)
   move.l pereadr,a0
   move obindex,d0
   subq #1,d0
   move d0,(a0)
y222: rts

   NON
objets:
	if STE=0
		move (.data-1484,pc,d1.w*2),d1
	else
		lea .data-1484,a1
		add d1,d1
		move 0(a1,d1.w),d1
	endif
   moveq #0,d7
   bra.s xylh
.data: dc.w 20,25,27,26,28,32

; dans d1 : obtype
; dans d7 : 0 obspec est sur la pile
;          -1 obspec dans d4
;           1 image ou icone, obspec dans d4, d2:largeur, d3:hauteur

xylh: addq #1,obindex
   move obindex,d0
   cmp #1,d0
   bne.s .lb0                    ; ce n'est pas le d‚but
   moveq #-1,d0                  ; sinon l'objet pointe sur -1
.lb0: move.l obptr,a1
   move d0,(a1)+                 ; pointe sur le suivant
   move.l #-1,(a1)+              ; pas encore d'enfants
   move d1,(a1)+                 ; obtype
   cmp #1,d7                     ; est-ce une image? ou une icone?
   beq.s .lb2                    ; si oui, h et l d‚j… calcul‚s
   addq.l #2,a6
   move.b (a6)+,d6
   move.b (a6)+,d3
   ext.w d3
   muls haut,d3
   ext.w d6
   add d6,d3                     ; hauteur
   addq.l #2,a6
   move.b (a6)+,d6
   move.b (a6)+,d2
   ext.w d2
   muls large,d2
   ext.w d6
   add d6,d2                     ; largeur
.lb2: addq.l #2,a6
   move.b (a6)+,d6
   move.b (a6)+,d0
   ext.w d0
   muls haut,d0
   ext.w d6
   add d6,d0                     ; y
   addq.l #2,a6
   move.b (a6)+,d6
   move.b (a6)+,d1
   ext.w d1
   muls large,d1
   ext.w d6
   add d6,d1                     ; x
   tst d7                        ; tedinfo d‚j… dans d4?
   bne.s .lb1
   move.l (a6)+,d4               ; spec
.lb1: move.l (a6)+,d5            ; state
   move.l (a6)+,d6               ; flag
   move d6,(a1)+
   move d5,(a1)+
   move.l d4,(a1)+
   move d1,(a1)+
   move d0,(a1)+
   move d2,(a1)+
   move d3,(a1)+
   move.l a1,obptr
   rts

   NON
boxtext:
	if STE=0
		move (.data-1496,pc,d1.w*2),d1   ; obtype
	else
		lea .data-1496,a0
		add d1,d1
		move 0(a0,d1.w),d1
	endif
	bra.s _boxtext
.data: dc.w 21,22,29,30
_boxtext: add.l #28,tedata  ; tedinfo suivante
   move.l tedata,a0
   clr.l -(a0)           ; longueurs nulles en attendant
   move (a6)+,-(a0)      ; largeur cadre dans la partie sup de couleur
   clr -(a0)
   move (a6)+,-(a0)      ; couleur , partie inf‚rieure
   move.l (a6)+,d0
   move d0,-(a0)         ; justification
   clr -(a0)
   cmp #25,d1
   bpl.s .masque         ; on saute si FTEXT ou FBOXTEXT
   move.l (a6)+,d0
   move d0,-(a0)         ; fonte
   move.l #nulle,-(a0)
   move.l (a0),-(a0)
   move.l (a6)+,a1       ; chaine
   move.l a1,-(a0)       ; adr texte
   move #1,26(a0)        ; len de mask
   bra.s .fin
.masque: move #3,-(a0)   ; toujours fonte normale
   move.l (a6)+,a1
   move.l a1,-(a0)       ; valid
   move.l (a6)+,a2
   move.l a2,-(a0)       ; mask
   move.l (a6)+,-(a0)    ; text
   move.l a2,a3
.lb2: tst.b (a3)+
   bne.s .lb2
   sub.l a2,a3
   move a3,26(a0)        ; len de mask
.fin: move.l a1,a2
.lb3: tst.b (a2)+
   bne.s .lb3
   sub.l a1,a2
   move a2,24(a0)        ; longueur+1
   moveq #-1,d7          ; tedinfo pr‚sente
   move.l a0,d4          ; son adresse dans d4
   bra xylh

; /////// fin d'appel gemlist

   SAUT
image: add.l #14,imagedat
   move.l imagedat,a0
   move.l (a6)+,d0
   move d0,-(a0)         ; couleur
   clr.l -(a0)           ; X et Y toujours nuls, l'image est aussi son cadre
   move.l (a6)+,a1       ; adresse des donn‚es
   move.l (a6)+,d3       ; hauteur
   move d3,-(a0)
   move.l (a6)+,d2       ; largeur en mots
   move d2,-(a0)
   asl #3,d2             ; *8 = largeur en points!
   move.l a1,-(a0)
   move.l a0,d4          ; adresse structure
   moveq #1,d7           ; image
   moveq #23,d1          ; G_IMAGE
   bra xylh

   SAUT
userdef:
   move.l imagedat,a0
   move.l a0,d4          ; obspec dans d4
   move.l (a6)+,4(a0)    ; paramŠtre user
   lea 8(a0),a1          ; le 'boot' de la routine
   move.l a1,(a0)
   move.l a1,a0
   move.l (a6)+,d0       ; code du mot ::
   lsl #2,d0             ; fois 4
   lea adresse,a1
   move.l 0(a1,d0),a1    ; adresse de ce mot
   addq.l #2,a1          ; on saute le code 437 ( [ass] )
   lea .userdat,a2
   move.l a1,16(a2)      ; fixe la bonne adresse
   moveq #6,d0
.lb0: move.l (a2)+,(a0)+
   dbf d0,.lb0           ; transfŠre le boot
   move.l a0,imagedat
   moveq #24,d1          ; G_USERDEF
   moveq #-1,d7          ; obspec dans d4
   bra xylh
.userdat:                ; boot des userdefs
   movem.l d1-a6,-(sp)
   move.l botmem,a6      ; pile provisoire
   move.l 60(sp),-(a6)   ; adresse des infos sur l'objet
   jsr userdef           ; saute … la routine
   move.l (a6)+,d0       ; paramŠtre de retour
   movem.l (sp)+,d1-a6
   rts

   SAUT
icon: move.l imagedat,a0
   move.l a0,d4          ; obspec
   moveq #31,d1          ; G_ICON
   moveq #1,d7           ; pour xylh
   moveq #84,d2          ; largeur ( 14 caractŠres * 6 points )
   moveq #40,d3          ; hauteur ( 32 image + 8 texte )
   move.l (a6)+,a1
   move.l a1,(a0)+       ; masque
   lea 128(a1),a1
   move.l a1,(a0)+       ; donn‚es
   move.l (a6)+,(a0)+    ; chaine
   move.l (a6)+,d0
   move d0,(a0)+         ; couleurs + caractŠre
   move.l (a6)+,d0
   move d0,(a0)+         ; x du caractŠre
   move.l (a6)+,d0
   move d0,(a0)+         ; y
   move.l #$1a0000,(a0)+   ; (26,0) = (x,y) de l'icone
   move.l #$200020,(a0)+   ; (32,32) = (l,h) de l'icone
   move.l #$000020,(a0)+   ; (0,32) = (x,y) du texte
   move.l #$540008,(a0)+   ; (84,8) = (l,h) du texte ( 14 caractŠres maximum )
   move.l a0,imagedat
   bra xylh

   SAUT
mfdbs:
	move.l #mfdb_s,-(a6)
	rts

	SAUT
mfdbd:
	move.l #mfdb_d,-(a6)
	rts

	SAUT
sndbadr:
	move.l #sndb,-(a6)
	rts

	SAUT
fillmfdb:
	move.l (a6)+,a3			; le mfdb
	moveq #2,d1
	move.l (a6)+,d0		  ; premier paramŠtre = -1 ?
   bpl.s .lb0				  ; non donc syntaxe normale
	XBIOS 2,2					; d0 = physbase
   move.l d0,(a3)+        ; oui,  c'est l'‚cran
   lea work_out,a1
   move.l (a1),d3
   add.l #$10001,d3
   move.l d3,(a3)+		  ; l et h
   swap d3
   move -(a1),d1			  ; nombre de plans
   moveq #0,d0				  ; mode shifter !
.commun:
   add.w #15,d3
   lsr #4,d3
   move d3,(a3)+          ; L en words
   move d0,(a3)+          ; format
   move d1,(a3)+          ; plans
	clr.l (a3)+
   clr (a3)               ; trois mots r‚serv‚s
   rts
.lb0: cmp.l d1,d0
	bpl.s .lb1				; plus de 0 ou 1, c'est une adresse !
	move.l (a6)+,d1     ; paramŠtres sur la pile
   move.l (a6)+,d2
   move.l (a6)+,d3
   move.l (a6)+,(a3)+     ; l'adresse
   move d3,(a3)+          ; L
   move d2,(a3)+          ; H
   bra.s .commun
.lb1:
	move.l d0,a0			; adresse de l'autre MFDB
	move.l (a0)+,(a3)+	; recopie les 20 octets !
	move.l (a0)+,(a3)+
	move.l (a0)+,(a3)+
	move.l (a0)+,(a3)+
	move.l (a0)+,(a3)+
	rts


   SAUT
vr_trnfm: lea control,a0
   move #110,(a0)+
   clr.l (a0)+
   clr.l (a0)+
   clr (a0)+
   move handle,(a0)+
   move.l #mfdb_s,(a0)+
   move.l #mfdb_d,(a0)
   VDI
   rts

   SAUT
vrt_cpyfm: lea control,a0
   move.l #$790004,(a0)+      ; fonction 121 et 4
   moveq #3,d0
   move.l d0,(a0)+
   clr.l (a0)+
   move handle,(a0)+
   move.l #mfdb_s,(a0)+
   move.l #mfdb_d,(a0)
   move.l (a6)+,d2            ; couleur fond
   move.l (a6)+,d1            ; couleur 1øplan
   move.l (a6)+,d0            ; mode
   movem.w d0-d2,intin        ; dans intin
deuxblocs: movem.l (a6)+,d0-d5        ; d0 = H, L, Yd, Xd, Ys, Xs = d5
   lea ptsin,a0
   move d5,(a0)+              ; coin sup
   move d4,(a0)+
   subq #1,d1
   subq #1,d0                 ; L-1 et H-1
   add d1,d5
   add d0,d4
   move d5,(a0)+              ; coin inf = Xs+L-1 et Ys+H-1
   move d4,(a0)+
   move d3,(a0)+              ; coin sup dest
   move d2,(a0)+
   add d1,d3
   add d0,d2
   move d3,(a0)+              ; coin inf = Xd+L-1 et Yd+H-1
   move d2,(a0)
   tst.b xy_flag
   beq.s .fin                 ; pas d'offset
   if STE=0
	   move.l ([fenetre]),d0      ; x y de la fenetre active
	else
		move.l fenetre,a0
		move.l (a0),d0
	endif
   tst.l mfdb_d
   bne.s .source              ; si <>0, ce n'est pas l'‚cran
   lea ptsin+8,a0
   add.l d0,(a0)+
   add.l d0,(a0)              ; ajoute l'offset
.source:
	tst.l mfdb_s
	bne.s .fin                 ; si <>0, pas l'‚cran
	lea ptsin,a0
	add.l d0,(a0)+
	add.l d0,(a0)              ; ajoute l'offset
.fin:
   VDI
   rts

   SAUT
vro_cpyfm: lea control(pc),a0
   move.l #$6D0004,(a0)+      ; fonction 109 et 4
   moveq #1,d0
   move.l d0,(a0)+
   clr.l (a0)+
   move handle,(a0)+
   move.l #mfdb_s,(a0)+
   move.l #mfdb_d,(a0)
   move.l (a6)+,d0
   move d0,intin              ; le mode
   bra deuxblocs

	SAUT
vm_coords:
	moveq #1,d0
	move.l a6,a0
	lea -4(a6),a6
	move.l a6,a1
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+
	move.l (a0),(a1)
	move.l d0,(a0)
	V1 5,0,5,99

	SAUT
v_opnwk:
	moveq #1,d0
	bra ouvrir

	SAUT
v_clswk:
	V3 2,0

	COPIE _page,hgf,1
_page: move.l fenetre,-(a6)
hgf: rts

	COPIE _fpu,fpuend,1
_fpu: move.l #is_fpu,-(a6)
fpuend:	rts

	SAUT
form_button:
	A1 56,2,2,1

	SAUT
form_keybd:
	A1 55,3,3,1

	SAUT
fsel_exinput:
	cmp #$140,global
	bpl.s .lb0			; si AES >= 1.40, on utilise la fonction
	addq.l #4,a6		; sinon, drop la chaine titre
	bra fsel_input		; et redirige sur l'ancienne fonction
.lb0:
	A1 91,0,2,3

	SAUT
menu_attach:
	A1 37,2,1,2

	SAUT
menu_istart:
	A1 38,3,1,1

	SAUT
menu_popup:
	A1 36,2,1,2

	SAUT
menu_settings:
	A1 39,1,1,1

	SAUT
objc_add:
	A1 40,2,1,1

	SAUT
objc_delete:
	A1 41,1,1,1

	SAUT
objc_order:
	A1 45,2,1,1

	SAUT
objc_sysvar:
	A1 48,4,3,0

	SAUT
rsrc_obfix:
	A1 114,1,1,1

	SAUT
wind_new:
	A1 109,0,1,0

	COPIE basepage,y123,1
basepage:
	move.l bspage,-(a6)
y123:rts

	COPIE _app,y122,1
_app:
	move.l _app_flag,-(a6)
y122: rts

	SAUT
reserve:
	move.l szone,-(sp)
	GEMDOS $49,6			; libŠre la table d'allocation dynamique

	ifnd LIB					; seulement sous l'‚diteur

	move.l debut_prog,d0
	move.l program,d1
	cmp.l d0,d1
	beq.s .deuxieme		; d‚j… utilis‚, le menu est sauv‚
	sub.l d0,d1				; taille … garder
	move.l d1,-(sp)
	move.l d0,-(sp)
	clr.w -(sp)
	GEMDOS $4a,12			; r‚duit au seul menu
	bra.s .suite
.deuxieme:
	move.l debut_prog,-(sp)
	GEMDOS $49,6			; libŠre la m‚moire
.suite:

	else

	move.l program,-(sp)
	GEMDOS $49,6			; libŠre la m‚moire

	endif

	move.l  #-1,-(sp)
   GEMDOS $48,6
	move.l d0,-(a6)
	moveq #100,d0
	move.l d0,-(a6)
	bsr div					; divis‚ par cent
	bsr mul					; taille fois x (pour cent)
	move.l (a6)+,d7
	move.l (a6),d0			; taille absolue en Ko
	moveq #10,d1
	asl.l d1,d0				; en octets
	add.l d0,d7  			; plus la taille absolue
   move.l  d7,-(sp)
   GEMDOS $48,6			; r‚serve
   bmi.s .erreur
   move.l d0,d1
   move.l d0,program
   ifnd LIB
   move.l d0,debut_prog
   endif
   move.l d0,topprg
   add.l d0,d7
   subq.l #4,d7
   move.l  d7,topmem
   move.l  d7,botmem
   move.l  #1028,-(sp)	; table d'allocation
   GEMDOS $48,6
   move.l  d0,a0
   move.l  d0,szone
   bmi.s .erreur
   clr.l (a0)+
   clr.l (a0)+
   moveq #-1,d0
   move.l  d0,(a0)
	move.l d7,(a6)
	rts
.erreur:
	move.l d0,(a6)
	rts

	SAUT
nvmaccess:
	move.l (a6)+,-(sp)
	movem.l (a6)+,d0-d2
	move d0,-(sp)
	move d1,-(sp)
	move d2,-(sp)
	XBIOS 46,12
	move.l d0,-(a6)
	rts

	SAUT
wdial_create:
   jsr ttt
   bne.s .lb0
   move #140,(a2)+
   lea 26(a2),a1
   move.l a1,(a0)
   move.l a2,a3
   bsr.s .lb1
   rts
.lb0: pea 26(a3)
   move.l (sp)+,(a1)
   bsr spass
   bsr.s .lb1
	rts
.lb1:
	move.l (a6)+,a0		; adresse de l'arbre
	moveq #0,d7				; pas d'offset
	move.l a0,(a3)+		; range l'adresse
	bclr #4,11(a0)			; bit OUTLINED effac‚
	bclr #5,11(a0)			; bit SHADOWED effac‚
	move 6(a0),d0			; type d'objet
	cmp #20,d0				; BOX ?
	beq.s .lb11
	cmp #25,d0				; IBOX ?
	bne.s .lb2
.lb11:
	clr.b 13(a0)			; efface bits 16-23 de ob_spec donc cardre … z‚ro
.lb2:
	move.l a0,fc_addrin
	GEM_AES wd_form_center
	lea fc_out+2,a0
	move.l (a0)+,(a3)+
	move.l (a0),(a3)+		; les coordonn‚es internes
	lea wc_in,a0
	clr (a0)+				; calculer l'ext‚rieur
	move #11,(a0)+			; TITLE, MOVER, CLOSER
	sub.l d7,(a0)+			; oter la bordure … X et Y
	add.l d7,d7				; la doubler en largeur et hauteur
	add.l d7,(a0)
	GEM_AES wd_wind_calc
	lea fc_out2+2,a0
	move.l (a0)+,(a3)+
	move.l (a0),(a3)+		; taille totale de la fenˆtre
	clr (a3)+				; handle … 0
	clr.l (a3)				; les pointeur du champ d'‚dition … 0
	rts

	SAUT
wdial_open:
	move.l (a6)+,a3
	move 20(a3),d7
	beq.s .premier
	lea wc_in,a0
	move d7,(a0)+
	move #10,(a0)+
	move d7,(a0)
	GEM_AES wd_wind_set
	ext.l d7
.fin:
	addq.l #8,a6			; ignore le titre et l'index edit
	move.l d7,-(a6)		; le handle est renvoy‚
	rts
.premier:
	lea fc_out,a0
	move #11,(a0)+		; mover, closer, title
	move.l 12(a3),(a0)+
	move.l 16(a3),(a0)	; x,y,l,h
	GEM_AES wd_wind_create
	move wc_in,d7
	ext.l d7
	bmi.s .fin
.table:
	lea wd_table,a0
.lb1:
	tst.l (a0)+			; cherche une place libre
	bne.s .lb1
	move.l a3,-(a0)	; ajoute cette structure dans la table
	move d7,20(a3)		; sauve le handle
	move.l (a6)+,d0	; chaine de titre
	move.l (a6)+,d1	; index edit
	move d1,22(a3)
	move.l (a3),a0		; arbre
	muls #24,d1
	add.l d1,a0
	btst #3,9(a0)		; objet ‚ditable?
	bne.s .oui
	clr.l 22(a3)
	bra .suite
.oui:
	move.l 12(a0),a0	; tedinfo
	move.l (a0),a0			; chaine saisie
	move.l a0,a1
.lb0:
	tst.b (a0)+
	bne.s .lb0
	sub.l a1,a0
	subq.l #1,a0
;	move a0,24(a3)			; position pour l'‚dition
	clr 24(a3)
.suite:
	lea wc_in,a0
	move d7,(a0)+			; handle
	move #2,(a0)+			; set TITLE
	move.l d0,(a0)			; adresse
	GEM_AES wd_wind_set
	lea fc_out,a0
	move d7,(a0)+
	move.l 12(a3),(a0)+
	move.l 16(a3),(a0)	; x,y,l,h
	GEM_AES wd_wind_open
	move.l d7,-(a6)
	rts

	SAUT
wdial_close:
	move.l (a6)+,a3
	move 20(a3),d7			; le handle
	beq.s .fin				; si nul, pas ouvert
	clr 20(a3)				; si on referme, handle nul
	move d7,wc_in
	GEM_AES wd_wind_close
	move d7,wc_in
	GEM_AES wd_wind_delete
	lea wd_table,a0
.lb1:
	cmp.l (a0)+,a3			; recherche dans la table
	bne.s .lb1
	clr.l -(a0)				; et ensuite efface cette adresse
.fin:
   rts

; renvoit 		0: rien … faire
; 			i	XXXX 1 : i=index du bouton exit ou i=-1 fermer fenetre

   SAUT
wdial_formdo:
	movem.l a4-a5,-(sp)
	move.l (a6)+,a5		; intout
	move.l (a6),a4	   	; le buffer de event-mesag
	movem.l a4-a5,.sauve	; pour un deuxiŠme appel cons‚cutif
.encore:
	clr.l (a6)				; renvoit 0 par d‚faut
	moveq #0,d6
	and #$13,(a5)			; ne garde que MESAG/BUTTON/KEYB
	move (a5)+,d6			; l'‚vŠnement
	bclr #4,d6				; teste si MESAG
	beq .k0
	move d6,-2(a5)			; range l'‚vŠnement avec MESAG en moins
	lea wd_table,a0
	move 6(a4),d7			; handle de la fenˆtre concern‚e
	moveq #19,d1			; pour boucler
.lb0:
	tst.l (a0)				; emplacement vide
	beq.s .lb1
	move.l (a0),a3
	cmp 20(a3),d7			; le bon handle?
	beq.s .lb2
.lb1:
	addq.l #4,a0
	dbf d1,.lb0
	bra .k0				; aucun handle ne convient, autre ‚vŠnement
.lb2:
	cmp #20,(a4)			; REDRAW?
	bne .z0
	clr .init_field		; pour le curseur
	tst 22(a3)				; champ ‚ditable?
	beq.s .r0
; a virer????
	lea wc_in,a0
	move d7,(a0)+
	move #10,(a0)
	GEM_AES wd_wind_get	; fenˆtre au top
	cmp fc_out+2,d7
	bne.s .r0
; ???
	lea 4(a3),a0			; si editable et fenetre au top, tout redessiner
	move #3,.init_field	; ED_END
	bra.s .r1
.r0:
	lea 8(a4),a0			; sinon, prendre les coordonn‚es de event-mesag
.r1:
	move.l d7,-(a6)
	moveq #0,d0
	rept 4
		move (a0)+,d0
		move.l d0,-(a6)	; copie les 4 coordonn‚es
	endr
	move.b xy_flag,xy_flag+1
	sf xy_flag				; mode absolu
	bsr set_redraw			; initialise
	move.l (a3),fc_addrin	; arbre pour object_draw
	move.l a3,-(sp)		; utilis‚ dans _redraw!
.r2:
	bsr _redraw
	tst.l (a6)+				; flag renvoy‚
	beq .r3					; si 0, c'est la fin
	lea fc_out,a0
	move.l #8,(a0)+
	move.l (a6)+,d0
	move.l (a6)+,d1
	move.l (a6)+,d2
	sub.l d2,d0
	addq #1,d0
	move.l (a6)+,d3
	sub.l d3,d1
	addq #1,d1
	move.w d3,(a0)+
	move.w d2,(a0)+
	move d1,(a0)+
	move d0,(a0)
	GEM_AES wd_object_draw
	bra.s .r2
.init_field: dc.w 0
.r3:
	move.l (sp)+,a3		; _redraw l'a ‚cras‚!
	tst 22(a3)				; champ ‚ditable?
	beq.s .non
	tst .init_field		; s'occuper du curseur?
	beq.s .non
	move.l (a3),fc_addrin	; l'arbre
	lea fc_out,a0
	move 22(a3),(a0)+			; index ‚ditable
	clr (a0)+					; touche inutile
	move 24(a3),(a0)+			; position
	move .init_field,(a0)	; ED_END
	GEM_AES wd_objc_edit
	move fc_out+2,24(a3)		; nouvelle position
.non:
	move.b xy_flag+1,xy_flag		; restaure le mode pr‚c‚dent.
					; renvoit 0, rien … faire!
	bra .fin
.z0:
	cmp #21,(a4)			; WM TOPPED?
	bne.s .z1
	lea wc_in,a0
	move d7,(a0)+
	move #10,(a0)+
	move d7,(a0)
	GEM_AES wd_wind_set	; top la fenetre D7
	tst 22(a3)				; un champ ‚ditable?
	beq .fin					; renvoit 0
; a virer ????
;	cmp #-1,global+2		; et multitos?
;	bne .fin
; ???
	lea fc_out,a0
	move #3,(a0)+			; FDM_FINISH
	clr.l (a0)+
	clr.l (a0)+
	move.l 4(a3),(a0)+
	move.l 8(a3),(a0)		; coordonn‚es int‚rieures
	GEM_AES wd_form_dial
	bra .fin					; renvoit 0
.z1:
	cmp #22,(a4)			; WM CLOSED?
	bne.s .z2
	moveq #-1,d0
	move.l d0,(a6)			; -1 pour fermer
	move.l a3,-(a6)		; renvoit XXXX
	moveq #1,d0
	move.l d0,-(a6)		; et 1, agir!
	bra .fin
.z2:
	cmp #28,(a4)			; WM MOVED?
	bne.s .k0
	lea wc_in,a0
	move d7,(a0)+			; le handle
	move #5,(a0)+			; deplace WF_CURRXYWH
	move.l 8(a4),(a0)+
	move.l 12(a4),(a0)	; x,y,w,h
	GEM_AES wd_wind_set
	move.l 4(a3),d0		; x,y internes
	sub.l 12(a3),d0		; offset interne/externe
	move.l 8(a4),d1		; nouvelles externes
	move.l d1,12(a3)		; dans la structure
	add.l d0,d1				; nouvelles internes
	move.l d1,4(a3)		; dans la structure...
	move.l (a3),a0			; (l'arbre)
	move.l d1,16(a0)		; ...et comme coordonn‚es du rectangle de l'arbre
	bra .fin					; renvoit 0
.k0:
	bclr #0,d6				; teste si KEYBD
	beq .k1
	move d6,-2(a5)
	tst 8(a5)
	beq .k1					; si touche=0, erreur!
	lea wc_in,a0
	move.l #10,(a0)
	GEM_AES wd_wind_get	; fenˆtre au top
	move fc_out+2,d7		; son handle
	lea wd_table,a0
	moveq #19,d1			; pour boucler
.lb8:
	tst.l (a0)				; emplacement vide
	beq.s .lb9
	move.l (a0),a3
	cmp 20(a3),d7			; le bon handle?
	beq.s .lb10
.lb9:
	addq.l #4,a0
	dbf d1,.lb8
					; fenetre pas … nous
	bra .fin
.lb10:
	move.l (a3),fc_addrin	; l'arbre
	lea fc_out,a0
	move 22(a3),(a0)+		; l'index (ou 0 si pas de FTEXT mais un DEFAULT)
	move 8(a5),(a0)+		; touche press‚e (dans intout de event multi)
	move 22(a3),(a0)+		; pour XaAES
	GEM_AES wd_form_keybd
	lea fc_out2,a0
	tst (a0)+				; 0 si bouton DEFAULT ou 1 autrement
	bne.s .lb11
	move (a0),d7			; index du bouton default
	bra .lb12				; sortie comme pour FORM BUTTON avec un EXIT
.lb11:
	move (a0)+,d6			; new_obj
	move (a0),d7			; key_out
	cmp 22(a3),d6
	beq.s .lb13
.new_obj:
	moveq #24,d0
	muls d6,d0
	move.l (a3),a0
	move.l 12(a0,d0.l),a0	; adresse tedinfo
	move.l (a0),a0			; texte
	move.l a0,d0
.lb14:
	tst.b (a0)+
	bne.s .lb14
	sub.l d0,a0
	subq.l #1,a0
	move a0,d5				; d6 contient new_objc et d5 contient new_pos
	move.l (a3),fc_addrin	; l'arbre
	lea fc_out,a0
	move 22(a3),(a0)+		; objet actuel
	clr (a0)+
	move 24(a3),(a0)+		; position
	move #3,(a0)			; ED_END
	GEM_AES wd_objc_edit
	move d6,22(a3)			; nouvel objet
	lea fc_out,a0
	move d6,(a0)+			; nouveau
	clr (a0)+
	move d5,(a0)+			; nouvelle position
	move #1,(a0)			; ED_INIT
	GEM_AES wd_objc_edit
	move fc_out2+2,24(a3)	; nouvelle position
.lb13:
	tst d7					; keyout=0??
	beq .fin
	lea fc_out,a0			; passer par objc_edit
	move 22(a3),d6			; new_obj
	move d6,(a0)+			; objet
	move d7,(a0)+			; touche
	move 24(a3),(a0)+		; position
	move #2,(a0)			; mode ED_CHAR
	GEM_AES wd_objc_edit
	swap d6
	move fc_out2+2,d6		; new_pos
	move d6,24(a3)			; mise … jour
					; rien … faire
	bra .fin
.k1:
	bclr #1,d6				; teste si BUTTON
	beq .fin
	move d6,-2(a5)
	lea wc_in,a0
	move.l #10,(a0)
	GEM_AES wd_wind_get	; fenˆtre au top
	move fc_out+2,d7		; son handle
	lea wd_table,a0
	moveq #19,d1			; pour boucler
.lb3:
	tst.l (a0)				; emplacement vide
	beq.s .lb4
	move.l (a0),a3
	cmp 20(a3),d7			; le bon handle?
	beq.s .lb5
.lb4:
	addq.l #4,a0
	dbf d1,.lb3
.lb7:
					; la fenetre au top n'est pas … nous
	bra .fin
.lb5:
	lea fc_out,a0
	move.l #8,(a0)+		; de l'objet 0 … 8 de profondeur
	move.l (a5),(a0)		; mousex et mousey (de evnt_multi)
	move.l (a3),fc_addrin	; l'arbre
	GEM_AES wd_objc_find
	moveq #0,d7
	move fc_out,d7
	bmi.s .lb7				; si <0, rien trouv‚
	move 12(a5),fc_out+2	; nombre de clicks
	GEM_AES wd_form_button
	tst fc_out
	beq.s .lb12
	moveq #0,d7		; pas de Keyout si newobj
	move fc_out+2,d6		; new_obj?
	bgt .new_obj			; oui, on s'occupe de d‚placer le curseur
	lsl d6
	lsr d6
	move d6,d7		; sinon objet EXIT (sans bit 15)
	; renvoit 0
	beq.s .fin		; peut pas etre nul! sinon on evite
.lb12:
	move.l d7,(a6)			; si un EXIT, renvoit l'index
	move.l a3,-(a6)		; et la structure
	moveq #1,d0
	move.l d0,-(a6)		; et 1
.fin:
	movem.l .sauve,a4-a5
	tst.l (a6)				; renvoit 0?
	bne.s .sortie			; non, traitement compl‚mentaire par utilisateur
	tst (a5)					; un ‚vŠnement reste encore?
	bne .encore				; oui, traiter!
.sortie:
	movem.l (sp)+,a4-a5
   rts
.sauve: dc.l 0,0

	SAUT
wdial_change:
	move.l (a6)+,a3		; la stucture
	move.l (a6)+,d6		; l'index de l'objet … modifier
	move.l (a3),a2
	moveq #24,d0
	muls d6,d0
	lea 10(a2,d0.l),a2	; adresse STATE
	move (a2),d5			; STATE
	bclr #0,d5				; sans son SELECTED
	move 20(a3),d7			; handle de la fenˆtre
	lea wc_in,a0
	move d7,(a0)+
	move #10,(a0)
	GEM_AES wd_wind_get	; fenˆtre au top
	cmp fc_out+2,d7      ; est-ce la bonne?
	beq.s .oui
	move d5,(a2)			; sinon, on modifie simplement le STATE
	rts
.oui:
	move.l (a3),fc_addrin	; l'arbre!
	lea fc_out,a0
	move d6,(a0)+			; l'objet
	clr (a0)+				; reserv‚
	move.l 4(a3),(a0)+	; x et y int‚rieurs
	move.l 8(a3),(a0)+	; h et l
	move d5,(a0)+			; nouvel ‚tat
	move #1,(a0)			; REDRAW
	GEM_AES wd_objc_change	; modifie l'objet et le redessine
	rts

	SAUT
wdial_evnt:
	move.l (a6)+,wd_evnt_multi+12		; intout
	move.l (a6)+,fc_addrin				; buffer pour mesag
	GEM_AES wd_evnt_multi
	rts										; valeurs retourn‚es dans les tableaux

	SAUT
vq_margin:
	move #2100,d0
	bra vdiquatre

	SAUT
vq_driver_info:
	move #2101,d0
	bsr vdiquatre
	lea intout+11,a0
	lea pad+2,a1
	move.l a1,-(a6)		; renvoit pad
	moveq #25,d0
.lb0:
   move.b (a0),(a1)+
   addq.l #2,a0
   dbf d0,.lb0
   clr.b	(a1)
	rts

	SAUT
vq_bit_image:
	move #2102,d0
	bra vdiquatre

	SAUT
vs_page_info:
	move.l (a6)+,a0			; texte
	move.l (a6)+,d0			; type
	lea intin,a1
	move d0,(a1)+
	move.l a0,d0
	moveq #0,d1
.lb0:
	move.b (a0)+,d1
	move d1,(a1)+
	bne.s .lb0
	sub.l d0,a0					; taille chaine
	addq.l #1,a0
	lea control,a1
	move.l #$50000,(a1)+
	move.l a0,(a1)+
	move.l #2103,(a1)+
	move handle,(a1)
	VDI
	rts

	SAUT
vs_crop:
	V1 5,0,6,2104

	SAUT
vq_image_type:
	move.l (a6)+,ptsin		; adresse bit-image
	move.l (a6)+,a0			; nom fichier
	lea intin,a1
	move.l a0,d0
	moveq #0,d1
.lb0:
	move.b (a0)+,d1
	move d1,(a1)+
	bne.s .lb0
	sub.l d0,a0					; taille chaine
	lea control,a1
	move.l #$50001,(a1)+
	move.l a0,(a1)+
	move.l #2105,(a1)+
	move handle,(a1)
	VDI
	rts

nul_ch: dc.l 48	; c'est le z‚ro par d‚faut

	SAUT
nul_char:
	move.l (a6)+,nul_ch
	rts

; fonctions AES pour les dialogues en fenˆtres

wd_form_center: dc.l fc_cont,global,dum,fc_out,fc_addrin,dum
fc_cont: dc.w 54,0,5,1,0
	dc.b "LALA"
fc_addrin: dc.l 0
wc_in: dc.w 0
fc_out: dc.w 0,0,0,0,0,0,0,0,0
fc_out2: dc.w 0,0,0,0,0,0,0,0,0

wd_wind_calc: dc.l wca_cont,global,wc_in,fc_out2,dum,dum

wd_wind_set: dc.l ws_cont,global,wc_in,fc_out,dum,dum

wd_wind_get: dc.l wg_cont,global,wc_in,fc_out,dum,dum

wd_wind_create: dc.l wc_cont,global,fc_out,wc_in,dum,dum

wd_wind_open: dc.l wo_cont,global,fc_out,wc_in,dum,dum

wd_wind_close: dc.l wl_cont,global,wc_in,wc_in,dum,dum

wd_wind_delete: dc.l wd_cont,global,wc_in,wc_in,dum,dum

wd_form_dial: dc.l fd_cont,global,fc_out,wc_in,dum,dum
fd_cont: dc.w 51,9,1,0,0

wd_object_draw: dc.l od_cont,global,fc_out,wc_in,fc_addrin,dum
od_cont: dc.w 42,6,1,1,0

wd_objc_find: dc.l of_cont,global,fc_out,fc_out,fc_addrin,dum
of_cont: dc.w 43,4,1,1,0

wd_form_button: dc.l fb_cont,global,fc_out,fc_out,fc_addrin,dum
fb_cont: dc.w 56,2,2,1,0

wd_form_keybd: dc.l fk_cont,global,fc_out,fc_out2,fc_addrin,dum
fk_cont: dc.w 55,3,3,1,0

wd_objc_edit: dc.l oe_cont,global,fc_out,fc_out2,fc_addrin,dum
oe_cont: dc.w 46,4,2,1,0

wd_objc_change: dc.l oc_cont,global,fc_out,fc_out2,fc_addrin,dum
oc_cont: dc.w 47,8,1,1,0

wd_evnt_multi: dc.l wem_cont,global,event_in,0,fc_addrin,dum
wem_cont: dc.w 25,16,7,1,0
event_in: dc.w 19,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0

	COPIE st,tim1
st: move.l #$fffa00,-(a6)
tim1: rts

	COPIE tt,tim2
tt: move.l #$fffa80,-(a6)
tim2: rts

   COPIE count,tim3
count: moveq #8,d1
	move.l d1,-(a6)
tim3:	rts

	SAUT
timera:
	moveq #0,d6
	bra.s _timer

	SAUT
timerb:
	moveq #1,d6
	bra.s _timer

	SAUT
timerc:
	moveq #2,d6
	bra.s _timer

	SAUT
timerd:
	moveq #3,d6

_timer:
	move.l (a6)+,d7		; auto ou software end of interrupt ou  timer stop
	cmp #2,d7
	beq .stop
	move.l (a6)+,d0		; fr‚quence voulue
	lea .dat_cont(pc),a0	; l… ou ranger data et control
	bsr data_control
	move.l (a6)+,d0		; delay (0) ou count (8)
	add.b d0,1(a0)			; ajoute le bit 3 si count
	clr.l -(sp)
	GEMDOS 32,6				; superviseur
	move.l d0,-(sp)		; pr‚pare le retour
	move sr,-(sp)			; conserve
	or #$700,sr				; plus d'interruptions

	move d6,d0
	muls #12,d0
	lea .table(pc,d0.w),a0	; donn‚es pour chaque timer
	move.l (a6)+,a3		; base des registres TT ou ST pour le MFP

	move.w (a0)+,d0		; offset enable/disable
	move.w (a0)+,d1		; num‚ro de bit
	bclr d1,0(a3,d0.w)	; invalide le timer
	bclr d1,12(a3,d0.w)
	lea .dat_cont,a1
	move.w (a0)+,d2		; offset data
	move.b (a1)+,0(a3,d2.w)
	move.w (a0)+,d2		; offset control
	cmp #2,d6
	bmi.s .ab
	move.b 0(a3,d2.w),d3	; ancienne valeur
	move.b (a1),d4			; le control … ajouter
	cmp #2,d6
	bne.s .d
	lsl.b #4,d4				; vers bits 4-6
	and.b #$F,d3			; garde bits 0-3
	bra.s .cd
.d:
	and.b #$F0,d3			; garde bits 4-7
.cd:
	or.b d4,d3
	move.b d3,0(a3,d2.w)	; nouveau control C ou D
	bra.s .suite
.ab:
	move.b (a1),0(a3,d2.w) ; control A ou B
.suite:
	move.l (a0)+,a1		; l'adresse de la routine
	cmp.l #$FFFA00,a3		; ST MFP?
	beq.s .stmfp
	add.w #$40,a1			; sinon d‚calage de $40 pour les adresses TT
.stmfp:
	move.l (a6)+,(a1)		; adresse de la routine
	tst d7					; sei ou aei
	beq.s .aei
	bset #3,$17(a3)		; soft end of inter
	bra.s .fin

.table: dc.w 7,5,$1f,$19
		  dc.l $134
		  dc.w 7,0,$21,$1b
		  dc.l $120
		  dc.w 9,5,$23,$1d
		  dc.l $114
		  dc.w 9,4,$25,$1d
		  dc.l $110
.aei:
	bclr #3,$17(a3)
.fin:
	bset d1,0(a3,d0.w)	; autorise l'interruption
	bset d1,12(a3,d0.w)
	move (sp)+,sr			; r‚cupŠre le registre d'‚tat
	GEMDOS 32,6				; mode utilisateur
	rts						; c'est parti mon kiki
.dat_cont: dc.b 0,0		; data et control
	; pour chaque timer: offset enable, nøbit, offset data, offset control
	; et pour finir adresse vecteur (st mfp)
	; 12 octets par timer


.stop:
	clr.l -(sp)
	GEMDOS 32,6
	move.l d0,-(sp)
	move sr,-(sp)
	or #$700,sr
	move d6,d0
	muls #12,d0
	lea .table(pc,d0.w),a0	; donn‚es pour chaque timer
	move.l (a6)+,a3		; base des registres TT ou ST pour le MFP
	move (a0)+,d0			; offset enable
	move (a0)+,d1			; nøbit
	bclr d1,0(a3,d0.w)	; disabled
	bclr d1,4(a3,d0.w)	; pending
	bclr d1,8(a3,d0.w)	; out service
	bclr d1,12(a3,d0.w)
	move (sp)+,sr
	GEMDOS 32,6
	rts

	SAUT
timer_calc:
	move.l (a6),d0
	move.l a6,a0
	bsr data_control
	moveq #0,d0
	moveq #0,d1
	move.b (a6),d0
	move.b 1(a6),d1
	move.l d0,(a6)
	move.l d1,-(a6)
	rts

	SAUT
solve:
	move.l (a6)+,d0
	move.l (a6)+,-(sp)
	move.l d0,-(sp)
	move.l (a6)+,-(sp)
	bsr get_function
	move.l a1,-(sp)
.encore:
	lea .petit(pc),a0		; 10^-4
	move.l (a0)+,-(a6)
	move.l (a0)+,-(a6)
	move.l 4(sp),a0		; x
	movem.l (a0),d0-d1
	tst.l d0
	bne.s .pasnul
	tst.l d1
	beq.s .xestnul			; si x est nul, h vaut 10^-4
.pasnul:
	movem.l d0-d1,-(a6)
	bsr ffois					; x*10^-4 = h
.xestnul:
	move.l (a6),-(sp)
	move.l 4(a6),-(sp)		; pile = h(inverse), *fonct, *x, epsilon
	move.l 12(sp),a0		; x
	move.l 4(a0),-(a6)
	move.l (a0),-(a6)
	move.l 4(a0),-(sp)
	move.l (a0),-(sp)		; pile = x, h, *fonct, *x, epsilon
	bsr fplus				; x+h
	move.l 20(sp),a0		; x
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)		; x=x+h
	move.l 16(sp),a0
	jsr (a0)					; f(x+h)
	bsr fneg
	move.l 20(sp),a0		; x
	move.l (sp)+,(a0)+
	move.l (sp)+,(a0)		; x redevient x, pile = h, *fonct, *x, epsilon
	move.l 8(sp),a0
	jsr (a0)					; f(x)
	bsr fswap				; fx -fx+h
	bsr fover				; fx -fx+h fx
	bsr fplus				; fx fx-fx+h
	move.l (sp)+,-(a6)
	move.l (sp)+,-(a6)	; h dans le bon ordre, pile = *fonct, *x, epsilon
	bsr fdiv					; fx -f'x
	bsr fdiv					; -fx/f'x
	bsr fdup
	move.l 4(sp),a0		; x
	move.l 4(a0),-(a6)
	move.l (a0),-(a6)
	bsr fplus				; x - fx/f'x, nouvel x
	move.l 4(sp),a0
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)+	; range dans x
	bclr #7,(a6)			; valeur absolue de dx
	movem.l (a6),d3-d4	; a conserver en cas de fin!
	lea 8(sp),a0
	move.l 4(a0),-(a6)
	move.l (a0),-(a6)		; epsilon
	bsr fsup
	tst.l (a6)+
	bne .encore
	lea 16(sp),sp			; vide tout
	movem.l d3-d4,-(a6)	; renvoit la precision
	rts
.petit: dc.l $eb1c432c,$3f1a36e2	; 10^-4 invers‚

get_function:
	move.l (a6)+,d0
	lea adresse,a1
	add.l d0,d0
	add.l d0,d0
	move.l 0(a1,d0.l),a1	; adresse fonction
	addq.l #2,a1			; saute code [ASS]
	rts

	SAUT
gauss:
	move.l (a6)+,-(sp)	; n
	bsr fover
	bsr fmoins				; b-a
	move.l (sp),-(a6)		; n entier
	bsr intfl				; n r‚el
	bsr fdiv					; h=(b-a)/n
	move.l (a6)+,-(sp)
	move.l (a6)+,-(sp)	; pile= h inv, n
	movem.l (a6)+,d0-d1	; a
	move.l (a6)+,a0		; pointeur sur x
	movem.l d0-d1,(a0)	; x=a
	move.l a0,-(sp)
	bsr.s get_function
	move.l a1,-(sp)		; pile = *f, *x, h inv, n
	clr.l -(sp)
	clr.l -(sp)				; l'int‚grale = 0, pile = S, *f, *x, h inv, n
	move.l 16(sp),-(a6)
	move.l 20(sp),-(a6)	; h
	lea .k3k2k1inverses(pc),a3	; inutilis‚ dans ffois
	move.l (a3)+,-(a6)
	move.l (a3)+,-(a6)
	bsr ffois				; h.k3
	move.l (a6)+,-(sp)
	move.l (a6)+,-(sp)
	move.l 24(sp),-(a6)
	move.l 28(sp),-(a6)	; h
	move.l (a3)+,-(a6)
	move.l (a3)+,-(a6)
	bsr ffois				; h.k2
	move.l (a6)+,-(sp)
	move.l (a6)+,-(sp)
	move.l 32(sp),-(a6)
	move.l 36(sp),-(a6)	; h
	move.l (a3)+,-(a6)
	move.l (a3)+,-(a6)
	bsr ffois				; h.k1
	move.l (a6)+,-(sp)
	move.l (a6)+,-(sp)	; pile = h.k1, hk2, hk3, S, *f, *x, h, n
.encore:
	subq.l #1,48(sp)		; decremente n
	bmi .terminus		; si n<0, integrale calculee
	moveq #16,d0			; k3
	moveq #0,d1				; m3
	bsr.s .un_point
	moveq #8,d0
	moveq #8,d1				; k2,m2
	bsr.s .un_point
	moveq #0,d0
	moveq #16,d1			; k1,m1
	bsr.s .un_point
	moveq #0,d0
	moveq #8,d1				; k1,m2
	bsr.s .un_point
	moveq #8,d0
	moveq #0,d1				; k2,m3
	bsr.s .un_point
	move.l 16(sp),-(a6)
	move.l 20(sp),-(a6)	; hk3
	move.l 36(sp),a0			; *x
	movem.l (a0),d0-d1
	movem.l d0-d1,-(a6)		; x
	bsr fplus					; x+k
	move.l 36(sp),a0			; *x
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)+		; x=x+k
	bra.s .encore
.un_point:
	lea .m3m2m1inverses(pc,d1.l),a0	; le bon m(1,2,3)
	move.l (a0)+,-(a6)
	move.l (a0)+,-(a6)		; sur la pile
	lea 4(sp,d0.l),a0			; le bon k
	move.l (a0)+,-(a6)
	move.l (a0)+,-(a6)		; sur la pile
	move.l 40(sp),a0			; *x
	movem.l (a0),d0-d1
	movem.l d0-d1,-(a6)		; x
	bsr fplus					; x+k
	move.l 40(sp),a0
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)+		; x=x+k
	move.l 36(sp),a0			; *f
	jsr (a0)
	bsr ffois					; f(x)*m
	lea 28(sp),a0				; pointeur sur S
	movem.l (a0),d0-d1
	movem.l d0-d1,-(a6)
	bsr fplus					; S+f(x)*m
	lea 28(sp),a0
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)+		; S=S+f(x)*m
	rts
.terminus:
	lea 24(sp),sp				; vire les hk
	movem.l (sp)+,d0-d1		; S
	movem.l d0-d1,-(a6)		; sur la pile
	addq.l #8,sp				; saute *f et *x
	move.l (sp)+,-(a6)
	move.l (sp)+,-(a6)		; h sur la pile
	bsr ffois					; Integrale = h*S
	addq.l #4,sp				; vire n
	rts
.k3k2k1inverses: dc.l $fd662cb0,$3fa80498
	dc.l $c57306ca,$3fc78891
	dc.l $fd99b705,$3fd13b23
.m3m2m1inverses: dc.l $c36e038c,$3fbe539e
	dc.l $25ae415b,$3fcea1da
	dc.l $789abcdf,$3fd23456

; renvoit 0 (ok) et la version en dessous
; renvoit n‚gatif sinon et pas de version

	SAUT
sc_check:
	move.l    #-1,-(sp)
   move.w    #36,-(sp)           ; Get Trap 4 Vektor
   BIOS 5,8
   move.l    d0,a0               ; trap 4 vector in d0 and a0
   cmp.l     #'XBRA',-12(a0)     ; Check XBRA ID
   bne.s       .not_inst
   cmp.l     #'SCTB',-8(a0)      ; Check SCTB ID
   bne.s       .not_inst
   move.l    -16(a0),-(a6)       ; Version Number
   moveq     #0,d0               ; Result Code
	bra.s .exit
.not_inst:
   moveq     #-1,d0              ; Result Code -1
.exit:
   move.l d0,-(a6)
   rts

	; " chemin\tool_box.bin" SC_load : installe les routines sur trap#4
	; renvoit 0: tout est ok
	; n‚gatif<-32: erreur GEMDOS (m‚moire insufisante ou fichier introuvable)
	; -32<negatif<0: erreur TOOLBOX

	SAUT
sc_load:
	move.l (a6)+,a3	; filename
	tst.l _sc_adr
	beq.s .lb0
	moveq #-12,d0			; fichier d‚j… charg‚
.exit:
	move.l d0,-(a6)
	rts
.lb0:
	move.l #18000,d0	; size
	tst.b is_mxal
	bne.s .lb1
	move.l d0,-(sp)
	GEMDOS 72,6			; old Gemdos, only ST Ram exists
	bra.s .lb2
.lb1:
	clr -(sp)			; new TOS,force ST RAM
	move.l d0,-(sp)
	GEMDOS 68,8
.lb2:
	tst.l d0
	bmi.s .exit			; erreur d'allocation
	move.l d0,_sc_adr	; sinon, sauve l'adresse
	clr -(sp)
	move.l a3,-(sp)	; file name
	move #$3d,-(sp)		; FOPEN, ouvre le fichier
	trap #1
	addq.l #8,sp

	move d0,d7
	bmi.s .exit			; erreur d'ouverture

	move.l _sc_adr(pc),-(sp)	; adresse
	move.l #18000,-(sp)	; taille maxi
	move d7,-(sp)
	move #$3f,-(sp)		; FREAD avec un maxi de D3 octets
	trap #1
	add.w #12,sp

	move d7,-(sp)
	move #$3E,-(sp)		; FCLOSE, referme le fichier lu
	trap #1
	addq.l #4,sp

	move.l _sc_adr(pc),a0
	move #-1,2(a0)		; ID fonction INSTALLE
	jsr (a0)				; ex‚cution
	move.l _sc_adr(pc),a0
	move.l 18(a0),d0	; valeur retourn‚e
	bra.s .exit

   COPIE sc_adr,y999,1
sc_adr: move.l _sc_adr,-(a6)
y999: rts
_sc_adr:	dc.l 0			; par d‚faut, rien de charg‚

	; renvoit 0 tout est ok
	; positif, erreur TOOLBOX

	SAUT
sc_unload:
	move.l _sc_adr(pc),d0
	bne.s .ok
	moveq #-1,d0		; erreur, rien de charg‚! routines absentes
.exit:
	move.l d0,-(a6)
	rts
.ok:
	move.l d0,a0
	move #-2,2(a0)		; ID fonction d‚sinstalle trap#4
	jsr (a0)
	move.l 18(a0),d0	; code retour
	bmi.s .exit
	move.l _sc_adr(pc),-(sp)
	GEMDOS 73,6			; free memory
	moveq #0,d0
	move.l d0,_sc_adr	; efface adresse m‚moire
	move.l d0,-(a6)	; renvoit 0: ok
	rts

; n SC_dma : fixe le numero de DMA du Supercharger
; d‚faut = 3

DMA: dc.w 3

	SAUT
sc_dma:
	move.l (a6)+,d0
	move d0,DMA
	rts

; pas de paramŠtre
; renvoit l'‚tat de la toolbox

	SAUT
sc_status:
	moveq #2,d0
	bra.s _sc_comm


; pas de paramŠtre
;	lance le mode esclave cot‚ Supercharger

	SAUT
sc_boot:
   moveq #3,d0
	bra.s _sc_comm

; srcatari destpc size sc_sendm (mode esclave)
; envoit size octets (max 64k) depuis srcatari vers destpc

	SAUT
sc_sendm:
   move.l (a6)+,d2
   move.l (a6)+,d3
   move.l (a6)+,a0
   moveq #6,d0
	bra.s _sc_comm

; srcpc destatari size sc_getm (mode esclave)
; recoit size octets (max 64k) de srcpc vers destatari

	SAUT
sc_getm:
   move.l (a6)+,d2
   move.l (a6)+,a0
   move.l (a6)+,d3
   moveq #7,d0
_sc_comm:				; comon end for routines
	move DMA(pc),d1
   trap #4
   move.l d0,-(a6)
   rts

; adrpc sc_exec (passe du mode esclave … coop‚ratif)
; ex‚cute le programme PC … l'adresse adrpc
; c'est le PC qui choisit quand il revient en mode esclave

	SAUT
sc_exec:
   move.l (a6)+,d3
   moveq #8,d0
	bra.s _sc_comm

; n sc_xsendb (mode coop‚ratif)
; envoie un octet au PC

	SAUT
sc_xsendb:
   move.l (a6)+,d2
   moveq #9,d0
	bra.s _sc_comm

; sc_xgetb (mode coop‚ratif)
; re‡oit un octet du PC

	SAUT
sc_xgetb:
	move DMA(pc),d1
   moveq #10,d0
   trap #4
   ext.w d2
   ext.l d2
   move.l d2,-(a6)
   move.l d0,-(a6)
   rts

; srcatari size sc_xsendm (mode coop‚ratif)
; envoie size octets (max 64k) depuis srcatari

	SAUT
sc_xsendm:
	move.l (a6)+,d2
	moveq #4,d0
	move.l (a6)+,a0
	bra.s _sc_comm

; destatari size sc_xgetm (mode coop‚ratif)
; re‡oit size octets (max 64k) vers destatari

	SAUT
sc_xgetm:
	move.l (a6)+,d2
	moveq #5,d0
	move.l (a6)+,a0
	bra.s _sc_comm

	COPIE imagesize,y1004
imagesize:
	move.l (a6)+,a1	; mfdb
	move 8(a1),d1		; paquets de 16 pix
	muls 12(a1),d1		; paquets de 16 pix * plans
	muls 6(a1),d1		; * h
	add.l d1,d1			; * 2 = taille en octets de l'image
	move.l d1,-(a6)
y1004:
	rts


; " chemin parx\" flag modset
; pas de retour
; flag	bit0 = 1 si passer souris en BUSY pendant dotrm/wim/ifx/rim

	SAUT
modset:
	lea mod_options,a1
	move.l (a6)+,(a1)+		; flag, a1 pointe sur chemin_mod maintenant
	move.l (a6)+,a0
	tst.b (a0)
	beq.s .marque				; chaine vide?
.lb0:
	move.b (a0)+,(a1)+
	bne.s .lb0
	cmp.b #'\',-2(a1)			; ceci ‚tait impossible sur une chaine vide
	beq.s .fin
	move.b #'\',-1(a1)
.marque:
	clr.b (a1)
.fin:
	rts


; " masque" flag tableau modmload
; charge tous les modules correspondant au masque
; les variables sont celles du tableau.
; flag=-1 pour ignorer la config
; si 1er ‚l‚ment du tableau =0, malloc, si =-1 dicco

	SAUT
modmload:
	bsr dta
	bsr fsd					; set dta sur dtabuf
	move.l (a6)+,a3		; premier ‚l‚ment du tableau
	move.l (a3),d3			; valeur … copier … chaque ‚lement (0/-1)
	beq.s .lba				; si 0 on garde
	moveq #-1,d3			; toute autre valeur amŠne … -1
.lba:
	move.l (a6)+,d4		; flag (-1,autre)
	move.l (a6)+,a0		; masque de recherche
	move.l #chemin_mod,-(a6)
	move.l a0,-(a6)
	move.l a3,-(sp)
	bsr path					; copie dans pad chemin + masque
	move.l (sp)+,a3
	move.l (a6)+,a0		; pad+2
	subq.l #1,a2			; retour sur le z‚ro final
.lb0:
	cmp.l a2,a0				; d‚but de chaine?
	beq.s .lb2
	move.b -(a2),d0
	cmp.b #'\',d0
	beq.s .lb1
	cmp.b #':',d0
	bne.s .lb0
.lb1:
	addq.l #1,a2			; pointe sur le pemier caractŠre du fichier.
.lb2:
	move.l a2,d5			; conserve l'adresse
	moveq #0,d6				; nombre de modules charg‚s
	clr -(sp)
	pea (a0)					; pad
	GEMDOS 78,8				; fsfirst
	bra.s .lb3
.loop:
	GEMDOS 79,2				; fnext
.lb3:
	tst.l d0
	bmi.s .fin
	lea dtabuf+30,a0		; nom du fichier
	move.l d5,a2
.copy_name:
	move.b (a0)+,(a2)+
	bne.s .copy_name
	lea pad+2,a0
	bset #7,(a0)			; marque le nom comme chemin complet
	move.l a0,-(a6)
	move.l d4,-(a6)		; flag
	move.l d3,(a3)			; valeur dans tableau
	move.l a3,-(a6)
	movem.l d3-d6/a3,-(sp)
	move.l topprg,-(sp)
	bsr modload				; charge un module
	move.l (sp)+,d2		; ancien topprg
	movem.l (sp)+,d3-d6/a3
	move.l (a6)+,d0
	bne.s .erreur
	addq.l #4,a3			; valeur suivante dans la tableau
	addq.l #1,d6			; une de plus
	bra.s .loop				; module suivant
.erreur:
	cmp #-3,d0				; module inconnu?
	bne.s .loop				; non, rien … faire, peut ˆtre erreur initialisation...
	tst.l d3
	bmi.s .dicco
	moveq #-32,d0
	add.l (a3),d0			; adresse module-32 = adresse bloc … lib‚rer
	move.l d0,-(sp)
	GEMDOS 73,6				; mfree
	bra.s .loop
.dicco:
	move.l d2,topprg		; si module inconnu, restaure dicco
	bra.s .loop
.fin:
	move.l d6,-(a6)		; renvoie le nombre de modules charg‚s
	rts

; " nom module" flag p modload
; si p=adr alors pas de nom, juste flag p modload
; flag: si une routine do_param est pr‚sente, alors ignorer (-1), sinon exec avec code=flag
; retour code d'erreur ou 0
; si nom module commence par >128, alors chemin complet, ne pas ajouter le chemin_mod

	SAUT
modload:
	move.l (a6)+,a2		; adresse de la variable
	lea .ma_var(pc),a0
	move.l a2,(a0)			; conserve pour les red‚finitions de mots (modules FOM)
	move.l (a6)+,d6		; le flag
	move.l (a2),d7			; adresse d'un module ou 0 (alloue) ou -1 (dicco)
	bgt.s .deja_la			; si var contient une adresse, module d‚j… l…
	movem.l a2/d6,-(sp)	; on garde la variable et le flag
	move.l (a6)+,a0		; chaine du nom
	bclr #7,(a0)			; si bit 7 mis, alors c'est un chemin complet
	bne.s .complet
	move.l #chemin_mod,-(a6)	; sinon, ajouter le chemin	par d‚faut
	move.l a0,-(a6)		; fichier
	bsr path
	move.l (a6)+,a0		; pad avec nom complet
.complet:
	move.l 4(sp),a2		; variable
	move.l #-32,-(a6)		; start=-32 pour r‚server 32 octets avant le chargement
	moveq #-1,d0
	move.l d0,-(a6)		; size = all (-1)
	move.l a0,-(a6)		; fichier
	move.l (a2),-(a6)		; variable = 0 ?
	beq.s .lb0				; si oui, laisser z‚ro, loadbin alloue un bloc
	move.l topprg,(a6)	; sinon, remplace par here dans le dictionnaire
.lb0:
	bsr loadbin
	movem.l (sp)+,a3/d6	; r‚cupŠre ma variable et le flag
	move.l (a6)+,d0		; taille lue ou code erreur
	tst.l (a3)				; 0 ou -1? (alloc ou dicco)
	bmi.s .lb2
	move.l (a6)+,d7		; adresse du bloc allou‚
	bra.s .lb1
.lb2:
	move.l topprg,d7		; allou‚ dans dicco
.lb1:
	moveq #32,d1			; offset
	tst.l d0
	bmi .sortie
	tst.l (a3)
	beq.s .lb3
	add.l d1,d0				; 32 octets de plus que la taille lue
	addq.l #1,d0
	bclr #0,d0				; rend d0 pair
	add.l d0,topprg		; met … jour le dicco
.lb3:
	add.l d1,d7				; se d‚cale de 32 octets
	move.l d7,(a3)			; met … jour la variable, pointe sur le module
.deja_la:
	bsr cache_off			; vide le cache pour accepter le module
	move.l d7,a3
	move.l #adresse,-(a3)	; var-4
	move handle,-(a3)			; var-6
	move i_handle,-(a3)		; var-8
	move.l #aespb,-(a3)		; var-12
	move.l #vdipb,-(a3)		; var-16
	move.l #langage,-(a3)	; var-20
	move.l #extra_data,-(a3)	; var-24
	move.l d7,a3
	move.l (a3),d1			; 4 premiers caractŠres
	moveq #0,d0
	cmp.l #"PARX",d1
	bne.s .autre
	move.l 4(a3),d1
	cmp.l #"_TRM",d1
	beq .trm					; ok, trm
	cmp.l #"_MEM",d1
	beq .sortie				; ok, memory manager
	cmp.l #"_BRO",d1
	beq .sortie				; ok, une brosse
	cmp.l #"_PAL",d1
	beq.s .sortie			; ok, une palette
	cmp.l #"_MOT",d1
	beq.s .sortie			; ok, un motif
	bra.s .unknown
.autre:
	moveq #68,d0
	cmp.l #"READ",d1		; RIM ou RSN ou FOM?
	beq.s .lb40
	cmp.l #"WRIT",d1		; WIM?
	beq.s .lb4
	moveq #60,d0
	CMP.l #"IFX_",d1		; IFX?
	beq.s .lb4
.unknown:
	moveq #-3,d0			; unknown module
	bra.s .sortie
.lb40:
	cmp.l #"_FOM",4(a3)	; module FORTH?
	bne.s .lb4				; non, donc suite
	btst #1,55(a3)			; marqueur red‚finition de mots
	beq.s .lb4				; pas de red‚finition
	bsr .redef_words
	moveq #68,d0			; remet l'offset pour do_param ‚ventuel
.lb4:
	btst #3,55(a3)			; marqueur do_exit … chainer
	beq.s .lb41
	bsr doexit_chain
	moveq #68,d0			; remet l'offset pour do_param ‚ventuel
.lb41:
	btst #0,55(a3)			; marqueur de module param‚trable
	beq.s .ok				; non pramam‚trable, tout est ok
	tst.l d6					; flag
	bmi.s .ok				; si -1, on ignore la routine
	add.l d0,a3				; adresse de do_param (car d0 effac‚ par cache)
	bsr cache_off2			; ‚teint r‚ellement les caches sur 040 et 060
	pea chemin_mod
	move d6,-(sp)			; code = flag
	jsr (a3)					; lance do_param
	addq.l #6,sp
	move.l d0,-(a6)		; code retour
	bsr cache_on2			; souvent do_param est un relogement!
	rts
.ok:
	moveq #0,d0
.sortie:
	move.l d0,-(a6)		; code d'erreur?
	rts
.trm:							; ici le TRM
	tst.l d6
	bpl.s .trm_normal		; flag>=0, cas Atari/carte graphique s‚lectionn‚e
	neg.l d6					; revient de -1 … 1, on va adapter la carte graphique aux donn‚es de Screen_Info
	cmp.w #252,8(a3)		; version 2.52 ?
	bne.s .trm_normal
	move.l a3,a0
	add.l #$9962,a0
	cmp.l #'CART',(a0)+	; marqueur donn‚es carte graphique
	bne.s .trm_normal
	cmp.l #'_GFX',(a0)+
	bne.s .trm_normal
	cmp.l #'FORT',(a0)+	; marqueur de ma carte sp‚ciale FORTHGFX
	bne.s .trm_normal
	cmp.l #'HGFX',(a0)+
	bne.s .trm_normal
	bsr .adapte_carte		; tout est ok, adaptons...
.trm_normal:
	moveq #0,d0
	move d0,-(sp)
	move.l d0,-(sp)
	move.l d0,-(sp)
	move.l d0,-(sp)
	move.l d0,-(sp)
	move.l d0,-(sp)
	move d6,-(sp)			; flag (0=Atari, 1=Carte graphique)
	move #2,-(sp)			; 2= Init
	jsr 1960(a3)
	lea 26(sp),sp
	bra.s .sortie
.adapte_carte:
	move.l code_ecran,d0
	and.l #$7FFF7FFF,d0
	swap d0					; nombre de plans d‚tect‚s
	moveq #0,d1
	lea .table16(pc),a0
	cmp #16,d0
	bmi.s .rien				; rien … faire en dessous de 16 bits
	beq.s .doit
	swap d0
	subq #1,d0
	bmi.s .rien				; rien … faire pour les modes 0 du 24/32 bits
	lea .table24(pc),a0
	swap d0
	cmp #24,d0
	beq.s .doit
	lea .table32(pc),a0
.doit:
	swap d0
	lsl #2,d0				; *4
	move.l 0(a0,d0.w),a0	; la bonne table
	move (a0)+,d0			; boucle
	bmi.s .double			; si <0, deux blocs
	move (a0)+,d1
	lea 0(a3,d1.l),a1		; destination
.doit1:
	move.l (a0)+,(a1)+
	dbf d0,.doit1
	rts
.double:
	move (a0)+,d1
	lea 0(a3,d1.l),a1		; destination1
	move (a0)+,d1
	lea 0(a3,d1.l),a2		; destination2
	neg d0
.doit2:
	move.l (a0)+,d1
	move.l d1,(a1)+
	move.l d1,(a2)+
	dbf d0,.doit2
.rien:
	rts
.table16: dc.l .moto16,.intel16,.moto15,.intel15
.moto16: dc.w 0,$9c1c
			dc.l $0200F800
.intel16: dc.w -4,$9bc0,$9c12
			dc.l $e0fd021c,$001f0303,$f801f800,$01f80107,$0502e0ff
.moto15: dc.w -3,$9bc0,$9c12
			dc.l $7c0101f8,$00030602,$0001e0fe,$0238011f
.intel15: dc.w -4,$9bc0,$9c12
			dc.l $e0fe0238,$001f0303,$f8017c01,$01f80103,$0602c0ff
.table24: dc.l .24bvr
.24bvr:	dc.w 2,$9b48
			dc.l $03ff01ff,$0002ff02,$ff0001ff
.table32: dc.l .32xbvr,.32bvrx,.32rvbx
.32xbvr:	dc.w 2,$9aaa
			dc.l $0003ff02,$ff0002ff,$03ff0001
.32bvrx: dc.w 3,$9aa6
			dc.l $03ff01ff,$0002ff02,$ff0001ff,$03ff0000
.32rvbx:	dc.w 3,$9aa6
			dc.l $01ff01ff,$0002ff02,$ff0003ff,$03ff0000
.ma_var: dc.l 0
.redef_words:
	btst #0,55(a3)			; marqueur de module param‚trable
	beq.s .rw0				; non pramam‚trable, offset D0=68 ok
	addq.l #4,d0			; sinon offset +4 (saute bra do_param)
.rw0:
	btst #3,55(a3)			; routine do_exit pr‚sente?
	beq.s .rw0a
	addq.l #4,d0			; offset+4 (saute bra do_exit)
.rw0a:
	move.l d0,-(sp)
	bsr cache_off2			; ‚teint r‚ellement les caches sur 040 et 060
	move.l (sp)+,d0
	moveq #0,d2
	move 12(a3),d2			; type=0 si normal, sinon n nombre de redefs de modexe (XFOM)
	swap d2					; doit rester nul pour modinfo et modpal
	lea 0(a3,d0.l),a0		; adresse des mots
.rw1:
	lea modinfo(pc),a2
	tst.b (a0)+				; nul?
	beq.s .rw2				; oui, ne pas red‚finir modinfo
	subq.l #1,a0
	bsr.s .rwadd
.rw2:
	lea modpal(pc),a2
	tst.b (a0)+				; nul?
	beq.s .rw3				; oui, ne pas red‚finir modpal
	subq.l #1,a0
	bsr.s .rwadd
.rw3:
	swap d2					; r‚cupŠre le type
	lea modexe(pc),a2
	move #$7000,d3			; moveq #0,d0
	tst d2					; type = 0 ?
	beq.s .rw7
	lea xmodexe(pc),a2	; sinon, routine ‚tendue
.rw7:
	tst.b (a0)+				; nul?
	beq.s .rw4				; oui, ne pas red‚finir modexe
	subq.l #1,a0
	bsr.s .rwadd
	cmp.b d2,d3
	bmi.s .rw7
.rw4:
	bsr cache_on2			; souvent do_param est un relogement!
	rts
.rwadd:
	lea mot,a1
	move.l a1,d1
.rw5:
	move.b (a0)+,(a1)+	; copie dans mot
	bne.s .rw5
	sub.l d1,a1
	move.l a1,d1
	subq.l #1,d1			; taille du mot dans mot
	addq.b #1,d3			; moveq suivant
	moveq.l #0,d4			; pour la recherche
	movem.l d2-d3/a3-a5,-(sp)
	jsr find_word
	movem.l (sp)+,a3-a5/d2-d3
	beq.s .rw6				; mot pas trouv‚, on ne red‚finit pas
	lsl.l #2,d4				; num‚ro du mot*4
	lea adresse,a1
	move.l 0(a1,d4.l),a1	; adresse du mot
	move.l #$01B52D3C,(a1)+	; 437 marqueur mot assembl‚, 2d3c=move.l #...,-(a6)
	move.l .ma_var,(a1)+
	tst d2
	beq.s .rw8
	move d3,(a1)+			; moveq #i,d0	pour les redefs multiples de modexe (XFOM)
.rw8:
	move #$4EF9,(a1)+			; jmp
	move.l a2,(a1)+		; modxxx ou xmodexe
.rw6:
	rts

doexit: dc.l 0				; pointeur chaine do_exit, z‚ro par d‚faut

extra_data:					; donn‚es suppl‚mentaires envoy‚es par modload
	dc.l ordres				; adresse des mots
	dc.l diko				; nombre de mots de base
	dc.l DEFNUM				; limite mots de base cr‚ant d'autres
xy_flag: dc.l $ff000000 ; par d‚faut, mode relatif
	dc.l 0					; version du FORTH en DCB (exemple version 2.15.7 = $00021507)
debut_prog:	dc.l 0		; d‚but du bloc dictionnaire
size_prog:	dc.l 0		; taille du bloc dictionnaire
	dc.l flags				; adresse des 16 flags
	dc.l forth				; adresse du WORD contenant le nombre de mots du dicco (base+user)

	; si un module contient une routine do_exit
	; il est chain‚ pour une ‚ventuelle sortie

doexit_chain:
	bsr.s find_doexit
	bne.s .fin				; erreur
	tst.l (a0)				; pointeur nul au d‚marrage?
	bne.s .fin				; non, erreur
	; ici tout est en place !
	lea doexit(pc),a1
	move.l (a1),(a0)		; le module pointe sur l'ancien d‚but de chaine
	move.l a3,(a1)			; et la chaine pointe sur ce module
.fin:
	rts

	; renvoie NE si erreur
	; EQ si tout va et A0 pointant sur le LONG de chainage
	; utilise A0/D0

find_doexit:
	moveq #68,d0
	btst #0,55(a3)			; do_param … sauter?
	beq.s .lb0
	addq.l #4,d0			; oui !
.lb0:
	lea 0(a3,d0.l),a0		; pointe sur BRA DO_EXIT
	cmp #$6000,(a0)+		; BRA?
	bne.s .fin				; non erreur
	add (a0),a0				; ajoute l'offset
	subq.l #8,a0
	cmp.l #'DoEx',(a0)+	; marqueur magique ?
	bne.s .fin				; non , erreur
	moveq #0,d0				; renvoie EQ
.fin:
	rts

; 1er-‚l‚ment n modmunoad
; d‚sinstalle les modules du tableau

	SAUT
modmunload:
	move.l (a6)+,d7		; nombre de modules
	move.l (a6)+,d6		; adresse premier
.loop:
	subq.l #1,d7
	bmi.s .fin
	move.l d6,-(a6)
	bsr.s modunload
	addq.l #4,d6			; element suivant
	bra.s .loop
.fin:
	rts

	; appel avec D3 =
	; - adresse d'un module, alors appelle son do_exit et l'enlŠve de la chaine
	; - z‚ro, alors appelle tous les do_exit de la chaine ! (fin de programme)
	; utilise a0,a2,a3,d1

call_doexit:
	lea doexit(pc),a2	; le module avait-il une routine do_exit?
	moveq #0,d1
.lb0:
	move.l (a2),a3	; un module...
	cmp.l a3,d1		; =0, fin de chaine ?
	beq.s .lb2
	bsr find_doexit
	bne.s .lb2		; erreur...
	tst.l d3			; si D3=0
	beq.s .all		; valider tous les modules
	cmp.l a3,d3		; notre module?
	bne.s .suivant
.all:
	move.l (a0)+,(a2)	; d‚fait le chainage de ce module
	movem.l d3/a4-a6,-(sp)
	move.l #sndb,-(sp)
	jsr (a0)			; appelle do_exit
	addq.l #4,sp
	movem.l (sp)+,d2/a4-a6
	bra.s .lb2
.suivant:
	move.l a0,a2	; nouveau pointeur
	bra.s .lb0
.lb2:
	rts

; p modunload
; retour p=0

	SAUT
modunload:
	move.l (a6)+,a0
	move.l (a0),d3
	beq.s .lb1		; variable vide?
	clr.l (a0)		; reset variable
	bsr.s call_doexit
	move.l d3,a3	; adresse module
	cmp.l #"PARX",(a3)
	bne.s .lb0
	cmp.l #"_TRM",4(a3)
	bne.s .lb0
	moveq #0,d0			; pour le TRM,on appelle END avant de lib‚rer la m‚moire.
	move d0,-(sp)
	move.l d0,-(sp)
	move.l d0,-(sp)
	move.l d0,-(sp)
	move.l d0,-(sp)
	move.l d0,-(sp)
	move d0,-(sp)
	move #3,-(sp)			; 3 = end
	jsr 1960(a3)
	lea 26(sp),sp
.lb0:
	pea -32(a3)				; le bloc commence 32 octets avant le module
	GEMDOS 73,6
.lb1:
	rts

; p modsname
; retour pad sur la pile avec le nom court

	COPIE modsname,y1003,1
modsname:
	if STE=0
		move.l ([a6]),a0
	else
		move.l (a6),a0
		move.l (a0),a0
	endif
	cmp.l #"PARX",(a0)	; TRM, MEM, BRO, MOT et PAL
	beq.s .lb0				; c'est leur short name "PARX_XXX"
	lea 14(a0),a0			; pour les autres, aller en 14
.lb0:
	lea pad+2,a1
	move.l a1,(a6)
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+
	clr.b (a1)
y1003:
	rts

; RSN/RIM/WIM/IFX	: p modlname
; retour pad sur la pile avec le nom long
; TRM : i p modlname
; retour pad sur la pile avec le nom de l'effet i
; FOM : i p modlname
; i=0 renvoie le nom long, i=1,2,3 renvoie la red‚finition de modinfo,modpal,modexe
; si modtype=n, <>0, il y a n d‚finitons pour modexe

	SAUT
modlname:
	if STE=0
		move.l ([a6]),a0
	else
		move.l (a6),a0
		move.l (a0),a0
	endif
	lea pad+2,a1
	cmp.l #"_FOM",4(a0)
	beq.s .fom
	cmp.l #"_TRM",4(a0)
	beq.s .trm
	cmp.l #"PARX",(a0)	; pour mem, et autres brosses : longname = short name
	beq.s modsname
.lname:
	lea 24(a0),a0
.copyname:
	move.l a1,(a6)
.lb0:
	move.b (a0)+,(a1)+
	bne.s .lb0
	rts
.trm:
	lea 1964(a0),a0	; ici sauter les palette et voir 2e paramŠtre...
	addq.l #4,a6
	move.l (a6),d0
	lsl.l #5,d0			; 32 caractŠres par chaine
	add.l d0,a0			; la bonne chaŒne
	bra.s .copyname
.fom:
	addq.l #4,a6
	move.l (a6),d0		; code pour FOM
	ble.s .lname		; si <=z‚ro, long name
	btst #1,55(a0)		; red‚finitions pr‚sentes?
	beq.s .vide			; non
	moveq #4,d1			; par d‚faut seuls 3 routines
	move 12(a0),d2		; type=0 ?
	beq.s .fom0			; oui, module FOM standard
	move d2,d1			; sinon, type = les n redefs de modexe
	addq.l #3,d1		; plus modinfo,modpal +1
.fom0:
	cmp.l d1,d0			; si valable 1,2,3,... n+2
	bmi.s .fom1			; oui, on continue
.vide:
	lea .dum(pc),a0	; non: chaine vide
	bra.s .copyname
.fom1:
	moveq #68,d1		; offset
	btst #0,55(a0)		; do_param pr‚sent?
	beq.s .fom4a
	addq.l #4,d1		; saute bra do_param
.fom4a:
	btst #3,55(a0)		; routine do_exit?
	beq.s .fom4
	addq.l #4,d1		; saute bra do_exit
.fom4:
	add.l d1,a0			; pointe sur les chaines
	subq #1,d0			; ramŠne … 0,1,2,...
	bra.s .fom2
.fom3:
	tst.b (a0)+			; avance d'une chaine
	bne.s .fom3
.fom2:
	dbf d0,.fom3
	bra .copyname
.dum: dc.b 0,0

; p modver
; retour le num‚ro de version

	COPIE modver,y1001
modver:
	if STE=0
		move.l ([a6]),a0
	else
		move.l (a6),a0
		move.l (a0),a0
	endif
	moveq #8,d0
	cmp.l #"PARX",(a0)	; version en +8 pour TRM, MEM et autres brosses
	beq.s .trm
	moveq #22,d0
.trm:
	move 0(a0,d0.l),d0
	move.l d0,(a6)
y1001:
	rts

; p modfmt
; retour le format 0 = _SHIfter, 1 = _VDI, 2 = les deux, pr‚cis‚ dans le mfdb
; ou pour les modules son: 3=pas de cache … vider/4=vider cache aprŠs modpal

	SAUT
modfmt:
	if STE=0
		move.l ([a6]),a0
	else
		move.l (a6),a0
		move.l (a0),a0
	endif
	moveq #0,d0
	cmp.l #"_MEM",4(a0)
	beq.s .out
	cmp.l #"_TRM",4(a0)
	bne.s .autre
	move 1958(a0),d0
	bra.s .out
.autre:
	cmp.l #"PARX",(a0)
	bne.s .autre2
	move 10(a0),d0		; format = nombre de plans pour brosses et autres
	bra.s .out
.autre2:
	cmp.l #'_SND',4(a0)
	bne.s .autre3
	move.b 12(a0),d0	; l'octet fort du type est le format !
	bra.s .out
.autre3:
	move.l 8(a0),d1
	cmp.l #'_SHI',d1
	beq.s .out			; mode 0
	moveq #1,d0
	cmp.l #'_VDI',d1
	beq.s .out			; mode 1
	moveq #2,d1
	cmp.l #'_VSH',d1
	beq.s .out			; mode 2
	moveq #-1,d1		; mode -1 = inconnu
.out:
	move.l d0,(a6)
	rts


; p modtype
; retour type de module pour WIM/RIM/IFX
; cas particuliers<0 TRM=-1, MEM=-2, BRO=-3, PAL=-4, MOT=-5
; -6 si "PARX" et inconnu...
; pour FOM : 0 si module PARX, n si n red‚finitions possibles de modexe

	COPIE modtype,y1000
modtype:
	moveq #0,d1
	if STE=0
		move.l ([a6]),a0
	else
		move.l (a6),a0
		move.l (a0),a0
	endif
	cmp.l #"PARX",(a0)
	bne.s .lb0
	move.l 4(a0),d0
	moveq #-1,d1
	cmp.l #"_TRM",d0
	beq.s .out
	moveq #-2,d1
	cmp.l #"_MEM",d0
	beq.s .out
	moveq #-3,d1
	cmp.l #"_BRO",d0
	beq.s .out
	moveq #-4,d1
	cmp.l #"_PAL",d0
	beq.s .out
	moveq #-5,d1
	cmp.l #"_MOT",d0
	beq.s .out
	moveq #-6,d1
	bra.s .out
.lb0:
	move 12(a0),d1		; ici cas RSN/WIM/RIM/IFX/FOM
	and.w #$ff,d1		; enlŠve l'octet haut du RSN
.out:
	move.l d1,(a6)
y1000:
	rts

; RIM :
;	    adr total " .EXT"  handle p modinfo
;		 l'extension peut ˆtre ‚galement le nom complet, le FORTH s'en charge de couper!
;      renvoie code d'erreur
; WIM :
;      p modinfo
;      avant remplir adresse,l,h,plans dans le mfdb_s
;		 retour: modifie mfdb, 1long=extension copi‚e aussi dans pad !
; TRM :
;      %bPRCCCID t  p modinfo
;      valide les paramŠtres
;		 options masque de bits (r=0/1 pour recouvrement, c=0,1,2,4,5 traitement des couleurs,
;										i=0/1 interactif, d=0/1 direction, p= 1 palette par d‚faut, ou 0 celle pass‚e)
;		 t=nøtramage ou 0/-1 pour le zoom (si version>=2.10)
;      retour 0 ok, -1 valeurs hors cadre
; RSN :
;      handle p modinfo
;      retour: 0 non reconnu
;              1 ok, compress‚
;					2 ok, non compress‚
; FOM : p modinfo		: passe le sndb comme paramŠtre, ou le mfdbs (si 16 dans le byte flag) … utiliser selon...
;		 retour: 0 erreur
;					2 Ok
;					aucun si module r‚gl‚ pour ne pas renvoyer D0

	SAUT
modinfo:
	move.l (a6)+,a0
	move.l (a0),a0				; adresse module
	moveq #0,d0
	lea mfdb_s,a1
	cmp.l #"READ",(a0)		; module lecture?
	bne .autre
	cmp.l #"_FOM",4(a0)		; un module FOM?
	beq .forthmod
	cmp.l #"_SND",4(a0)		; module son?
	beq .sound					; oui !
	move.l (a6)+,d0			; sinon, c'est un RIM ici.  file handle
	move d0,18(a1)				; stocke le handle
	pea (a1)						; mfdb, 1er paramŠtre
	move.l (a6)+,a2			; adresse chaine extension
	bsr.s .find_ext			; isole l'extension si c'est un nom complet, et majuscules!
	lea mfdb_s,a1
	move.l d0,-(sp)			; extension, second paramŠtre
	move.l (a6)+,d0
	move.l d0,-(sp)			; taille totale du fichier, 3e param
	move.l d0,-(sp)			; = taille charg‚e, 4e param
	move.l d0,-8(a0)			; sauv‚e pour modpal dans les 32 octets avant le module
	move.l (a6)+,d7
	move.l d7,-(sp)			; adresse des donn‚es 5e param
	move.l d7,-4(a0)			; sauve pour modexe
	clr -(sp)					; code=0 6e param
	jsr 56(a0)					; test file !
	lea 22(sp),sp				; corrige la pile
.exit:
	move.l d0,-(a6)
	rts
.find_ext:
	move.l a2,a1				; conserve le d‚but
.lb0:
	tst.b (a2)+
	bne.s .lb0					; va … la fin de la chaine
	moveq #3,d1					; pour 4 caractŠres
	subq #1,a2
.lb1:
	move.b -(a2),d0
	cmp.b #'a',d0
	blt.s .lb2
	cmp.b #'z',d0
	bhi.s .lb2
	and.b #$DF,d0				; min -> maj
.lb2:
	ror.l #8,d0
	cmp.l a1,a2					; d‚j… en d‚but de chaine?
	dbeq d1,.lb1				; continue jusqu'… 4 caractŠres ou si d‚but de chaine
	rts
.autre:
	cmp.l #"WRIT",(a0)
	bne.s .autre2
	move.l (a1),-4(a0)		; conserve l'adresse des donn‚es
	move.l a1,-(sp)			; param mfdb
	jsr 56(a0)
	addq.l #4,sp
	lea pad+2,a0
	move.l mfdb_s,(a0)+		; copie l'extension de fichier
	clr.b (a0)					; et termine la chaine
	move.l d0,-(a6)
	rts
.autre2:
	cmp.l #"PARX",(a0)
	bne.s .exit
	cmp.l #"_TRM",4(a0)
	bne.s .exit
	moveq #-1,d0					; par d‚faut erreur
	movem.l (a6)+,d2-d3		; d2=tramage, d3=masque options
	bclr #6,d3
	sne -13(a0)					; -13(a0)=FF si demande de palette par d‚faut
	bclr #4,d3
	sne -14(a0)					; -14(a0)=FF si demande la palette actuelle
	move d2,-2(a0)				; conserve le tramage
	and #$003F,d3				; seulement 6 bits
	move d3,-4(a0)				; conserve les options rcccid sur 6 bits
	lsr #2,d3
	and #7,d3					; isole ccc
	cmp #2,d3
	bgt .exit					; ccc ne doit pas d‚passer 2 !
	cmp 1958(a0),d2			; tramage hors limites?
	bgt .exit
	cmp #210,8(a0)				; version >=210?
	bmi.s .nozoom
	cmp #-2,d2					; tramage <=-2? (0 et -1 autoris‚s pour le zoom ver 2.10)
	bra.s .lb3
.nozoom:
	tst d2						; tramage <=0 ? (0 et -1 exclus pour ver<210)
.lb3:
	ble .exit
	moveq #0,d0					; sinon tout va!
	bra .exit
.sound:							; ici un SND !
	lea sndb,a1
	move.l (a6)+,12(a1)		; file handle
	move.l a1,-(sp)			; le sndb
	jsr 56(a0)					; test file !
	addq.l #4,sp				; corrige la pile
	move.b d0,126(a1)			; conserve le retour !
	bra .exit
.forthmod:
	move.l a0,a3				; pour harmoniser
	lea 56(a3),a0				; l… ou sauter !
	bra _forthmod				; partie commune au son et fom

; RIM :
;      adr-pal p modpal
; WIM :
;      adr-pal p modpal
; TRM :
;      pal-source pal-dest p modpal
; RSN :
;      adrs adrd p modpal
; FOM :
;		p modpal	: passe juste le sndb en paramŠtre

	SAUT
modpal:
	move.l (a6)+,a3
	move.l (a3),a3				; adresse module
	moveq #0,d0
	lea mfdb_s,a1
	cmp.l #"READ",(a3)		; module RIM/RSN ?
	bne .autre
	cmp.l #"_FOM",4(a3)
	beq .forthmod
	cmp.l #"_SND",4(a3)		; est-ce un RSN ?
	beq .sound
	move.l -8(a3),d7			; ici RIM : r‚cupŠre taille fichier sauv‚e
	move.l (a6)+,a2			; adresse palette dest VDI
	move.l (a1),d5				; offset palette
	add.l -4(a3),d5			; adresse palette du fichier
	move.l d7,(a1)				; conserve la taille totale
	move.l a1,-(sp)			; param1 = mfdb
	moveq #0,d1					; pas de couleur?
	move.l 14(a1),d6			; taille palette
	beq.s .paspal				; si z‚ro, pas de palette … charger!
	move 12(a1),d0				; nombre de plans
	moveq #1,d1
	lsl.l d0,d1					; nombre de couleurs!
.paspal:
	move.l d1,-(sp)			; param2 = nbr coul
	move.l a2,-(sp)			; param3 = adresse palette destination
	move.l d6,-(sp)			; param4 = taille donn‚es palette source
	move.l d5,-(sp)			; param5 = adresse palette source
	clr -(sp)					; code=0
	jsr 60(a3)
	cmp #2,d0
	bne.s .erreur
	lea mfdb_s,a1
	move.l (a1),d1				; seek vers les donn‚es
	add.l 14(a1),d1			; plus taille donn‚es
	sub.l d7,d1					; d‚passement de bloc ? (oui si d1>0)
	ble.s .erreur				; non, pas de d‚passement!
	move.l d1,-(a6)			; sinon taille du d‚passement
	moveq #3,d0					; et nouveau code !
.erreur:
	lea 22(sp),sp
.exit:
	move.l d0,-(a6)
	rts
.autre:
	cmp.l #"WRIT",(a3)
	bne.s .autre2
	move.l (a6)+,d1			; adresse palette
	move.l d1,-8(a3)			; sauv‚e
	move.l d1,-(sp)			; param 1 palette
	move.l -4(a3),(a1)		; r‚cupŠre l'adresse des donn‚es
	move.l a1,-(sp)			; param 2 mfdb
	jsr 60(a3)
	addq.l #8,sp
	bra.s .exit
.autre2:
	cmp.l #"PARX",(a3)
	bne.s .exit
	cmp.l #"_TRM",4(a3)
	bne.s .exit
	move.l (a6)+,a0			; pal-dest
	move.l (a6)+,d1			; pal source
	move.l a0,-8(a3)			; sauv‚e
	move.l d1,-12(a3)			; idem
	move -4(a3),-(sp)			; les options sauv‚es
	move.l a0,-(sp)			; pal dest
	lea mfdb_d,a1
	pea (a1)
	move.l a0,d0
	beq.s .lb0					; adresse nulle, on ne copie pas de palette
	tst.b -14(a3)				; flag palette actuelle
	beq.s .lb1					; non, voir palette par d‚faut...
	movem.l a0-a3/d0-d3,-(sp)
	move.l a0,-(a6)			; adresse ou stocker la palette
	bsr savevdipal				; et la sauvegarde dans pal dest
	movem.l (sp)+,a0-a3/d0-d3
	bra.s .lb0
.lb1:
	tst.b -13(a3)				; flag palette par d‚faut
	beq.s .lb0					; non, on garde celle donn‚e
	move 12(a1),d0				; plans destination
	cmp #8,d0					; au dela des modes palette?
	bgt.s .lb0					; oui, donc on oublie
	moveq #2,d1					; taille-1 en longs de la palette
	lea 12(a3),a1				; palette mono
	lsr d0						; vire un bit
	beq.s .copy_pal
	moveq #5,d1
	lea 24(a3),a1				; palette 4 coul
	lsr d0
	beq.s .copy_pal
	moveq #23,d1
	lea 48(a3),a1				; palette 16 coul
	lsr d0
	beq.s .copy_pal
	move #383,d1
	lea 144(a3),a1				; palette 256 coul
	lsr d0
	bne.s .lb0					; au dela de 8 plans, pas besoin de palette ! (‚trange car d‚j… v‚rifi‚)
.copy_pal:
	move.l (a1)+,(a0)+
	dbf d1,.copy_pal
.lb0:
	pea 0.l
	pea mfdb_s
	pea 0.l
	moveq #0,d1					; par d‚faut TRM_ENQUIRE
	move -2(a3),d0				; le tramage sauv‚
	bgt.s .normal
	neg d0						; ici, TRM ZOOM !
	moveq #4,d1					; donc ZOOM_ENQUIRE
.normal:
	move d0,-(sp)
	move d1,-(sp)			   ; code = inquire (0 ou 4)
	jsr 1960(a3)
	lea 26(sp),sp
	bra .exit
.sound:
	btst #0,13(a3)				; RSN total? (tout charger en RAM..?)
	beq.s .total
	addq.l #8,a6				; vire les paramŠtres
	moveq #0,d0					; erreur
	bra .exit
.total:
	lea sndb,a2
	move.l (a6)+,d3			; adresse "destination"
	bne.s .rsn1					; d‚j… fournie (ou -1 ignorer), pas de r‚servation
	cmp.b #1,126(a2)			; retour de modinfo: compress‚ ou non?
	bne.s .rsn1					; non, donc pas de r‚servation !
	move.l 8(a2),-(a6)
	bsr allot
	move.l (a6)+,d3
.rsn1:
	move.l (a6)+,d4			; adresse "source" (donn‚es/compress‚es)
	seq 127(a2)					; flag=FF si r‚servation dicco
	bne.s .rsn2
	bsr remember
	move.l 4(a2),-(a6)
	bsr allot
	move.l (a6)+,d4
.rsn2:
	move.l d3,-(sp)			; dest
	move.l d4,-(sp)			; source
	move.l a2,-(sp)			; sndb
	jsr 60(a3)					; appelle le module
	lea 12(sp),sp
	move.l d0,-(a6)			; valeur retour
	tst.b 127(a2)				; flag
	beq.s .rsn3
	cmp #1,d0					; comression..??
	bne.s .rsn3					; non
	bsr restore					; si oui, vire la zone source
.rsn3:
	cmp.b #4,13(a3)			; 04 si vider caches aprŠs chargement (car contient du code)
	bne.s .exit2
	bsr cache_off
.exit2:
	rts
.forthmod:
	lea 60(a3),a0
	; continue sur forthmod !!
	;

	; pour les modules READ_FOM, le sndb est pass‚ sur -(sp)
	; ou bien c'est mfdb_s selon le bit 4 dans config
	; le module lui-meme peut lire la pile (a6) et la modifier
	; en retour d0 est empil‚ sauf si bit#2 mis dans la config
	; routine commune pour modinfo, modpal et modexe
	; (a0) contient l'offset du branchement.

_forthmod:						; module FORTH g‚n‚ral, passe sndb en paramŠtre
	move.l a3,-(sp)			; adresse module
	lea sndb,a1					; par d‚faut envoyer sndb
	btst #4,55(a3)
	beq.s .ok
	lea mfdb_s,a1				; si bit 4 config mis, envoyer mfdb_s
.ok:
	move.l a1,-(sp)
	jsr (a0)
	addq.l #4,sp
	move.l (sp)+,a0			; adresse module
	btst #2,55(a0)				; renvoyer D0 ?
	bne.s .exit					; bit mis, on ne renvoie rien
	move.l d0,-(a6)			; sinon empile d0
.exit:
	rts


; RIM :
;      bufdest p modexe
;      le mfdb contient d‚j… adresse/taille des donn‚es
;      en retour, code d'erreur
; WIM :
;		 buf handle p modexe
;	    mfdb complet normalement, buf allou‚ avec la taille de modpal,
;      et fichier de sortie ouvert avec handle
;      renvoie la taille restant … sauver ddans le buffer (sans fseek)
; TRM :
;      buf p modexe
; IFX :
;		 type z‚ro: 1er appel PAL1 0 p modexe (et mdfbs rempli)
;						2e  appel PAL1 PAL2 p modexe
;		 type un  : 1er appel PAL1 PAL2 mfdb3 0 p modexe
;                 2e  appel PAL1 PAL2 mfdb3 PAL3 p modexe
; RSN :
;      n p modexe
;      n = num‚ro du morceau >0
;      n = 0 pour stopper le son
;      n = -1 pour lire l'‚tat
;		 n = -2 commande et envoie 2 paramŠtres en 32 et 36(sndb)
;      Dans tous les cas, renvoie le num‚ro du morceau en cours ou 0

	SAUT
modexe:
	move.l (a6)+,a3
	move.l (a3),a3				; adresse module
	moveq #0,d0
	lea mfdb_s,a1
	cmp.l #"READ",(a3)		; module RIM?
	bne.s .autre
	cmp.l #'_FOM',4(a3)
	beq .forthmod
	cmp.l #'_SND',4(a3)		; son?
	beq .sound
	move.l a1,-(sp)			; param 1 mfdb
	move.l 14(a1),-(sp)		; param 2 taille donn‚es image
	move.l (a1),d0				; offset donn‚es
	add.l -4(a3),d0			; + adresse d‚part
	move.l d0,-(sp)			; param 3 adr donn‚es image
	move.l (a6)+,(a1)			; buffer de destination dans mfdb
	clr -(sp)					; code = 0
	jsr 64(a3)					; traite l'image !
	lea 14(sp),sp				; corrige la pile
.exit
	move.l d0,-(a6)
	rts
.autre:
	cmp.l #"WRIT",(a3)
	bne.s .autre2
	move.l (a6)+,d0			; handle
	move d0,14(a1)				; dans le mfdb
	move.l (a6)+,-(sp)		; param 1 buffer de travail
	move.l -8(a3),-(sp)		; param 2 palette sauv‚e
	move.l a1,-(sp)			; param 3 mfdb
	jsr 64(a3)
	lea 12(sp),sp
	bra.s .exit
.autre2:
	cmp.l #"IFX_",(a3)
	bne.s .autre3
	tst 12(a3)					; type ?
	beq.s .type0
	move.l (a6)+,-(sp)		; pal3
	move.l (a6)+,-(sp)		; mfdb3
.type0:
	move.l (a6)+,-(sp)		; pal2
	pea mfdb_d					; dest
	move.l (a6)+,-(sp)		; pal1
	pea mfdb_s					; src
	jsr 56(a3)
	lea 16(sp),sp
	tst 12(a3)
	beq.s .exit
	addq.l #8,sp
	bra.s .exit
.autre3:
	cmp.l #"PARX",(a3)
	bne.s .exit
	cmp.l #"_TRM",4(a3)
	bne.s .exit
	move -4(a3),-(sp)			; options
	move.l -8(a3),-(sp)		; pal dest
	pea mfdb_d
	move.l -12(a3),-(sp)		; pal source
	pea mfdb_s
	move.l (a6)+,-(sp)		; buffer
	moveq #1,d1					; par d‚faut TRM_DO
	move -2(a3),d0				; le tramage sauv‚
	bgt.s .normal
	neg d0						; ici, TRM ZOOM !
	moveq #5,d1					; donc DO ZOOM
.normal:
	move d0,-(sp)
	move d1,-(sp)			   ; code = TRM DO (1 ou 5)
	jsr 1960(a3)
	lea 26(sp),sp
	bra .exit
.sound:
	lea sndb,a0
	move.l (a6)+,d0			; commande
	moveq #-2,d1
	move.l d0,-(sp)			; numero n (ou commande)
	pea (a0)						; le sndb
	cmp.l d1,d0					; si -2, deux paramŠtres en plus!
	bne.s .sound2
	move.l (a6)+,32(a0)		; remplit param1
	move.l (a6)+,36(a0)		; et param2
.sound2:
	jsr 64(a3)
	addq.l #8,sp
	bra .exit
.forthmod:
	lea 64(a3),a0				; pour un FOM
	bra _forthmod

	; une red‚finition de modexe est:
	; dc.w 437
	; move.l var,-(a6)
	; moveq #n,d0				; paramŠtre pour s‚lectionner la sous fonction
	; jmp xmodexe

xmodexe:
	move.l (a6)+,a3
	move.l (a3),a3				; le module
	move.l #'XFOM',d1			; marqueur de validation
	lea 64(a3),a0				; modexe
	bra _forthmod


;  adr-data  size-data  filename  handle  adr-pal  flag   p  dorim
;  organisation m‚moire
;  dicco....: fichier + bloc supp + donn‚es image : topprg
;  si flag<>0, alors ramŠne donn‚e images sur le fichier et r‚duit topprg
;	return: -1 erreur dans MODINFO, -2 dans MODPAL, -3 dans MODEXE
;  return 2/3 si tout va bien et mfdbs rempli avec adresse donn‚es et PAL avec palette !
;  en cas d'erreur seul le fichier reste en m‚moire, autres blocs effac‚s

	SAUT
dorim:
	bsr busy_on
	bsr pair					; aligne le dicco au cas o—
	bsr remember			; en cas d'erreur pour d‚piler les blocs
	moveq #-1,d0
	move.l d0,-(a6)
	move.l #mfdb_s,-(a6)
	bsr fillmfdb				; remplit avec donn‚es ‚cran
	move.l (a6)+,a3		; variable module
	move.l (a6)+,d5		; flag !
	beq.s .lb1
	move.l 16(a6),d5		; si flag<>0, conserver adr-data
.lb1:
	move.l (a6)+,d7		; adresse palette (ou z‚ro)
	movem.l a3/d7/d5,-(sp)
	move.l a3,-(a6)		; remet le module
	bsr modinfo
	movem.l (sp)+,a3/d7/d5
	move.l (a6)+,d6		; retour
	cmp #2,d6
	bmi _buginfo
	move.l d7,-(a6)
	move.l a3,-(a6)
	movem.l a3/d6/d5,-(sp)
	bsr modpal
	movem.l (sp)+,a3/d6/d5
	move.l (a6)+,d0
	cmp #2,d0
	bmi.s _bugpal
	beq.s .lb0		; code 2, pas de d‚passement
	jsr allot		; code 3, taille … allouer sur la pile
	addq.l #4,a6	; adresse du bloc inutile, il est coll‚ … la fin du fichier
.lb0:
	move.l #mfdb_s,-(a6)
	bsr imagesize	; taille des donn‚es d‚compress‚es
	move.l (a6),d7	; sauv‚es en cas de flag=1
	jsr allot		; adresse dans dicco sur la pile
	move.l a3,-(a6)
	movem.l d5-d7,-(sp)
	bsr modexe
	movem.l (sp)+,d5-d7
	move.l (a6)+,d0
	cmp #3,d0
	bmi.s _bugexe
	subq.l #4,remb		; d‚pile dans remember devenu inutile
	tst.l d5
	beq.s _do_exit		; rien … faire
	lea mfdb_s,a2
	move.l (a2),a1		; donn‚es source
	move.l d5,a0		; zone destination (fichier)
	move.l d5,(a2)		; nouvelle adresse
	moveq #16,d0
.lb2:
	move.l (a1)+,(a0)+
	move.l (a1)+,(a0)+
	move.l (a1)+,(a0)+
	move.l (a1)+,(a0)+
	sub.l d0,d7
	bgt.s .lb2
	add.l d7,a0			; corrige si trop d‚plac‚
	move.l a0,topprg
	bsr pair				; selon D7...
	bra.s _do_exit
_bugexe:
	moveq #-3,d6
	bra.s _do_exit_rest
_bugpal:
	moveq #-2,d6
	bra.s _do_exit_rest
_buginfo:
	moveq #-1,d6
_do_exit_rest:
	bsr restore			; en cas d'erreur d‚truit les blocs tempraires
_do_exit:
	move.l d6,-(a6)
	bsr busy_off
	rts

; masque tramage pal1 pal2 flag t dotrm
; renvoie -1 (erreur info), -2 (erreur pal) -3 (erreur exe)
; ou 0 OK
; si la source est le dernier bloc allou‚, alors la m‚moire est:
; dictionaire: ... source...dest...temp...topprg
; le temoraire est automatiquement effac‚.
; si bit0 de flag=1, dest est copi‚ sur source et source perdue, topprg ajust‚.
; si le TRM r‚alisait d‚j… un recouvrement, avec flag=1 topprg est ajust‚ sur la nouvelle taille
; 	(augment‚ ou r‚duit!)
; si bit1 de flag est mis, on v‚rifie en sortie que le format est SHIFTER, si ce n'est pas
;  le cas, un appel … vr_trnfm est r‚alis‚
; en cas d'erreur, seul source reste en m‚moire

	SAUT
dotrm:
	bsr busy_on
	bsr pair				; au cas o—...
	bsr remember		; en cas d'erreur, enlever les blocs inutiles
	move.l (a6)+,a3	; le module
	move.l (a6)+,d5	; flag
	move.l (a6)+,d6	; pal2
	move.l (a6)+,d7	; pal1
	move.l a3,-(a6)	; remet le module
	bsr modinfo
	tst.l (a6)+
	bne.s _buginfo
	clr.l mfdb_d		; au cas o— l'utilisateur ne l'a pas fait
	move.l d7,-(a6)
	move.l d6,-(a6)
	move.l a3,-(a6)
	movem.l a3/d5,-(sp)
	bsr modpal
	movem.l (sp)+,a3/d5
	moveq #0,d6			; par d‚faut buffer inutile
	move.l (a6)+,d7		; taille … r‚server ou z‚ro
	bmi.s _bugpal
	lea mfdb_d,a2
	tst.l (a2)
	bne.s .lb0			; si adresse remplie, rien … faire
	move.l a2,-(a6)
	bsr imagesize		; sinon, calcule la taille n‚cessaire
	jsr allot			; alloue le bloc
	move.l (a6)+,(a2)	; comme adresse de donn‚es dans mfdb_d
.lb0:
	tst.l d7
	beq.s .lb1			; rien … r‚server
	cmp.l #$7FFFFFFF,d7	; taille maxi?
	bne.s .lb6
	bsr free				; taille maximale dispo
	move.l (a6)+,d7	; la taille obtenue
.lb6:
	move.l d7,-(a6)
	bsr remember		; sauve
	jsr allot			; alloue le bloc
	move.l (a6)+,d6	; son adresse
	move.l d6,a0
	move.l d7,(a0)		; la taille du bloc dans les 4 premiers octets
.lb1:
	move.l d6,-(a6)
	move.l a3,-(a6)
	move.l d5,-(sp)
	bsr modexe
	move.l (sp)+,d5
	tst.l d7
	beq.s .lb2
	bsr restore			; vire le buffer temporaire
.lb2:
	tst.l (a6)+
	bne _bugexe
	subq.l #4,remb		; annuler 1er remember, garder les blocs
	moveq #0,d6
	btst #0,d5
	beq.s	.lb7			; bit0 flag=0, pas de r‚duction d'espace !
	move.l mfdb_s,d3	; adresse source
	lea mfdb_d,a2
	move.l a2,-(a6)
	bsr imagesize		; taille donn‚es dest
	move.l (a6)+,d7
	addq.l #1,d7
	bclr #0,d7
	move.l d3,a0		; source … ‚craser
	add.l d7,d3
	move.l d3,topprg	; nouvelle fin
	move.l (a2),a1		; dest … d‚placer
	cmp.l a1,a0			; mˆme adresse pour les deux mfdb ?
	beq.s .lb7			; oui, d‚j… recouvrement, on a ajust‚ la taille
.lb4:
	move.l a0,(a2)		; nouvelle adresse pour dest
	moveq #16,d0
.lb5:
	move.l (a1)+,(a0)+
	move.l (a1)+,(a0)+
	move.l (a1)+,(a0)+
	move.l (a1)+,(a0)+
	sub.l d0,d7
	bgt.s .lb5
.lb7:
	btst #1,d5			; doit-on v‚rifier le format de sortie?
	beq _do_exit		; no, on s'en va !
	lea mfdb_d,a2
	tst 10(a2)			; format SHIFTER?
	beq _do_exit		; yes! rien … faire
	lea mfdb_s,a3
	move.l a2,-(a6)	; pour imagesize
	move.l a2,-(a6)
	move.l a3,-(a6)
	movem.l a2-a3,-(sp)
	bsr fillmfdb		; copie dest sur source
	bsr imagesize
	movem.l (sp),a2-a3
	move.l topprg,(a2)	; vers le dictionnaire
	clr 10(a2)			; vers mode shifter
	bsr vr_trnfm		; transforme!
	movem.l (sp)+,a2-a3
	move.l (a2),a1		; donn‚es dest actuelles
	move.l (a3),a0		; zone source … recouvrir
	move.l (a6)+,d7	; taille donn‚es (de imagesize)
	moveq #0,d5			; pour ne pas boucler ind‚finiment
	bra.s .lb4

; type 0 : PAL1 PAL2 p doifx
; type 1 : PAL1 PAL2 mfdb3 PAL3 p doifx
; renvoie 	-1: erreur premier appel
;				-2: erreur second appel
;				0: r‚ussi au premie appel
;				1: r‚ussi au second avec zone dest sans palette
;				2: r‚ussi au second avec zone dest et palette

busy_off:
	moveq #0,d0
	bra.s *+4
busy_on:
	moveq #2,d0		; busy
	btst #0,mod_options+3
	beq.s .exit
	move.l d0,-(a6)
	bsr graf_mouse
.exit:
	rts


	SAUT
doifx:
	bsr busy_on
	moveq #0,d7					; pour le premier passage
	move.l (a6)+,a3			; module
	move.l (a3),a2
	tst 12(a2)					; type ?
	beq.s .type0
	move.l (a6)+,d6			; pal3
	move.l (a6)+,d5			; mfdb3
.type0:
	move.l (a6)+,d4			; pal2
	move.l (a6),d3				; pal1 reste sur la pile
	tst 12(a2)
	beq.s .lb0
	subq.l #8,a6				; pal2 et mfdb3 inchang‚s
.lb0:
	clr.l -(a6)					; remplace PAL2 ou PAL3 au premier appel
.premier:
	move.l a3,-(a6)
	movem.l d3-d7/a3,-(sp)
	bsr modexe
	movem.l (sp)+,d3-d7/a3
	move.l (a6)+,d2
	bmi.s .erreur1				; premier passage erreur
	beq.s .erreur1				; si ok, renvoie le z‚ro = r‚ussi au premier passage
	move.l d2,d7				; conserve pour le retour !
	move.l (a3),a1
	tst 12(a1)
	beq.s .lb1
	cmp #2,d2					; TYPE 1 : besoin de palette?
	beq.s .lb2					; oui, garder pal3
	moveq #0,d6					; sinon annuler PAL3
.lb2:
	move.l d5,a2				; et travailler sur mfdb3
	bra.s .lb3
.lb1:
	cmp #2,d2					; TYPE 0 : besoin de palette?
	beq.s .lb4
	moveq #0,d4					; annuler PAL2 si inutile
.lb4:
	lea mfdb_d,a2
.lb3:
	move.l a2,-(a6)			; calcule la taille detination n‚cessaire
	bsr imagesize
	jsr allot					; alloue le bloc
	move.l (a6)+,(a2)			; stock‚ dans mfdb_d ou mfdb3 selon TYPE
	move.l d3,-(a6)			; PAL1
	move.l d4,-(a6)			; PAL2 ou z‚ro
	move.l (a3),a1
	tst 12(a1)
	beq.s .lb5
	move.l d5,-(a6)			; mfdb3
	move.l d6,-(a6)			; PAL3 ou z‚ro
.lb5:
	move.l a3,-(a6)			; le module
	movem.l d3-d7/a3,-(sp)
	bsr modexe					; second appel !
	movem.l (sp)+,d3-d7/a3
	move.l (a6)+,d2
	bmi.s .erreur2				; si n‚gatif
	move.l d7,d2				; si r‚ussi renvoie 1 ou 2 du premier appel
	bra.s .erreur1
.erreur2:
	moveq #-2,d2
.erreur1:
	move.l d2,-(a6)
	bsr busy_off
	rts

; fichier PAL flag var dowim
; flag = bit0=1 pour vr_trnfm automatique
;			bit1=1 pour ajout de l'extension conseill‚e
; retour si n‚gatif
;	-1 tailles diff‚rentes
;  -2 format diff‚rent
;  -4 plans diff‚rents		(toute combinaison des 3 possible de -1 … -7)
;	-8 erreur MODPAL, format incompatible
;	-9 erreur MODEXE, va savoir...
; autres n‚gatifs : erreur GEMDOS cr‚ation/‚criture
; retour 0 si ok

	SAUT
dowim:
	bsr busy_on
	bsr remember			; conserve ‚tat
	move.l (a6)+,a3		; variable du module
	move.l (a6)+,d7		; le flag
	move.l (a6)+,d6		; la palette
	move.l (a6)+,d5		; le nom de fichier
	move.l #mfdb_s,a0
	move.l (a0),d4			; adresse des donn‚es
	move.l (a3),a1			; le module
	move 10(a0),-10(a1)	; sauve le format d'origine
	move.l a0,-(a6)
	move.l #mfdb_d,-(a6)
	bsr .appel_info		; fillmfdb + modinfo
	lea mfdb_s+4,a0
	lea mfdb_d+4,a1
	moveq #0,d0
	cmp.l (a0)+,(a1)+		; mˆmes tailles ?
	beq.s .lb0
	bset #0,d0
.lb0:
	addq.l #2,a0
	addq.l #2,a1
	cmp (a0)+,(a1)+		; mˆme format?
	beq.s .lb1
	bset #1,d0
.lb1:
	cmp (a0)+,(a1)+		; mˆmes plans?
	beq.s .lb2
	bset #2,d0
.lb2:
	btst #0,d7				; flag trnfm auto?
	beq.s .lb3				; non!
	cmp #2,d0				; seul le format … changer?
	bne.s .lb3				; non, donc on passe
	; ici vr_trnfm
	lea mfdb_s,a0
	lea mfdb_d,a1
	move.l a1,-(a6)
	move.l a0,-(a6)		; pour recopier ensuite
	;	move.l (a0),d4			; file extension
	move.l (a1),(a0)		; r‚cupŠre l'adresse des donn‚es
	move 10(a0),d0
	move 10(a1),10(a0)
	move d0,10(a1)			; ‚change les formats
	move.l a1,-(a6)
	bsr imagesize
	jsr allot
	move.l (a6)+,mfdb_d	; adresse destination
	movem.l d4-d7/a3,-(sp)
	bsr vr_trnfm			; transforme !
	movem.l (sp)+,d4-d7/a3
								; repasse dest sur source avec le bon format
	bsr .appel_info		; l… on est bon normalement...!!!
	moveq #0,d0
.lb3:
	neg.l d0
	bne .retour
	btst #1,d7				; flag pour forcer l'extension?
	beq.s .lb4
	bsr .add_ext			; renvoie dans D5=pad fichier+extension conseill‚e
.lb4:
	move.l d6,-(a6)		; PAL
	move.l a3,-(a6)		; module
	movem.l d4-d7/a3,-(sp)
	bsr modpal
	movem.l (sp)+,d4-d7/a3
	move.l (a6)+,d0		; retour
	bmi.s .erreur_pal
	subq.l #4,a6
	jsr allot
	move.l (a6)+,d7		; adresse bloc temporaire
	clr -(sp)
	move.l d5,-(sp)
	GEMDOS 60,8				; fcreate
	move.l d0,d5			; file handle
	bmi.s .retour			; si erreur, renvoie le code GEMDOS
	move.l d7,-(a6)		; bloc temporaire
	move.l d5,-(a6)		; handle
	move.l a3,-(a6)		; module
	movem.l d4-d7/a3,-(sp)
	bsr modexe
	movem.l (sp)+,d4-d7/a3
	move.l (a6)+,d0		; taille … sauver ou erreur
	bmi.s .erreur_exe
	move.l d7,-(sp)	; adresse bloc
	move.l d0,-(sp)	; taille … sauver
	move d5,-(sp)
	GEMDOS 64,12		; fwrite
	move.l d0,d7
	bsr.s .ferme
	move.l d7,d0
	bmi.s .retour		; renvoie l'erreur GEMDOS … l'‚criture
	moveq #0,d0			; sinon, 0 tout est ok !
	bra.s .retour
.erreur_exe:
	bsr .ferme
	moveq #-9,d0
	bra.s .retour
.erreur_pal:
	moveq #-8,d0
.retour:
	move.l d0,-(a6)		; valeur renvoy‚e
	lea mfdb_s,a0
	move.l d4,(a0)			; remet l'adresse d'origine
	move.l (a3),a1			; le module
	move -10(a1),10(a0)	; et le format d'origine
	bsr restore				; remet le dictionnaire en ‚tat
	bsr busy_off
	rts
.appel_info:
	move.l a3,-(a4)		; >r
	movem.l d4-d7/a3,-(sp)
	bsr fillmfdb
	move.l (a4)+,-(a6)	; r> r‚cupŠre a3
	bsr modinfo				; teste le bloc
	addq.l #4,a6			; n'utilise pas la valeur de retour
	movem.l (sp)+,d4-d7/a3
	rts
.ferme:
	move d5,-(sp)
   GEMDOS 62,4						; fclose!
	rts
.add_ext:
	move.l d5,a0			; chaine du nom
	lea pad+2,a1
	move.l a1,d5			; nouvelle chaŒne
	move.l (a1),d0			; extension conseill‚e d‚j… dans pad
	moveq #0,d1
.ae0:
	move.b (a0)+,d2
	move.b d2,(a1)+
	beq.s .ae1				; fin de chaine
	cmp.b #".",d2
	bne.s .ae2
	move.l a1,a2
	moveq #1,d1				; un point trouv‚
	bra.s .ae0
.ae2:
	cmp.b #"\",d2
	bne.s .ae0
	moveq #0,d1				; reset, on oublie s'il y a eu un point
	bra.s .ae0
.ae1:
	tst d1
	beq.s .ae3				; pas de point, on garde a1 fin de chaine
	move.l a2,a1			; sinon retour sur point
.ae3:
	addq.l #3,a1			; trois caractŠres plus loin
	clr.b (a1)				; fin de chaŒne
	moveq #3,d1
.ae4:
	move.b d0,-(a1)		; copie l'extension
	lsr.l #8,d0
	dbf d1,.ae4
	rts

	; si intin.l = "FORT", alors force l'appel des routines internes
	;					et ne mets pas … jour global, puis intin effac‚

	SAUT
rsrc_rcfix:
	moveq #33,d5			; les C-ICON restent elles-mˆmes
	bclr #0,3(a6)			; annule le bit0 de l'adresse
	beq.s .lb7				; il ‚tait d‚j… nul, rien … changer
	moveq #31,d5			; si adresse impaire, passer de c-icon … icon
.lb7:
	cmp.l #'FORT',intin
	beq.s .ma_routine		; force la routine interne
	tst agi_intout+8		; RSRC_FIX support‚ par le systŠme?
	beq.s .ma_routine		; non, donc FORTH remplace
	A1 115,0,1,1			; sinon appel … l'AES r‚cent
.ma_routine:
	bsr _char_info			; remplit d7 = large et haut (pour un caractŠre)
	swap d7					; d'abord la largeur (pour x,y,l,h dans l'ordre)
	move.l (a6)+,a3		; adresse du RSC en m‚moire
	cmp #5,(a3)				; premier mot <=5 (format 0/1 + 4 pour nouveau format)
	bgt .erreur
	move.l a3,d3
	btst #2,1(a3)			; teste si format ‚tendu (icones couleurs)
	beq.s .normal
	bsr .extension			; va g‚rer l'extension ! (d6=table des pointeurs)
.normal:
	moveq #1,d0
	bsr .offset				; a0 pointe sur les objets
	move 20(a3),d0			; nombre d'objets
	move.l d6,a1			; ‚ventuel table coclor icon
	bra.s .lb0
.fixobj:
	move 6(a0),d1			; type
	cmp #33,d1				; coclor icon?
	bne.s .lb6
	move d5,6(a0)			; transforme ‚ventuellement en icon
	move.l 12(a0),d1		; index
	lsl.l #2,d1				; *4
	move.l 0(a1,d1.l),12(a0)	; pointe sur la bonne icone !
	bra.s .lb1
.lb6:
	cmp #20,d1				; box?
	beq.s .lb1
	cmp #25,d1				; ibox?
	beq.s .lb1
	cmp #27,d1				; boxchar?
	beq.s .lb1
	add.l d3,12(a0)		; pour tous les autres, reloger ob_spec
.lb1:
	lea 16(a0),a0			; pointe sur les coordonn‚es
	moveq #3,d2
.fixxylh:
	moveq #0,d1
	move.b (a0),d4			; offset
	move.b 1(a0),d1		; nombre de caractŠres
	ext.w d4					; ‚tend le signe
	muls d7,d1				; fois haut ou large
	swap d7
	add d4,d1
	move d1,(a0)+
	dbf d2,.fixxylh
.lb0:
	dbf d0,.fixobj
	moveq #2,d0
	bsr.s .offset			; a0 pointe sur les tedinfos
	move 24(a3),d0			; nombre de tedinfos
	bra.s .lb2
.fixted:
	add.l d3,(a0)+
	add.l d3,(a0)+
	add.l d3,(a0)+			; trois pointeurs de chaine … reloger
	lea 16(a0),a0			; 12+16 = 28 octets/ted
.lb2:
	dbf d0,.fixted
	moveq #4,d0
	bsr.s .offset			; a0 pointe sur les bitblk
	move 28(a3),d0			; nombre de bitblk
	bra.s .lb3
.fixbb:
	add.l d3,(a0)			; un seul pointeur … reloger
	lea 14(a0),a0
.lb3:
	dbf d0,.fixbb
	moveq #3,d0
	bsr.s .offset			; a0 pointe sur les ICONBLK
	move 26(a3),d0			; nombre d'ICONBLK
	bra.s .lb4
.fixicon:
	add.l d3,(a0)+
	add.l d3,(a0)+
	add.l d3,(a0)+			; trois pointeurs … reloger
	lea 22(a0),a0			; 12+22=24 octets/icon
.lb4:
	dbf d0,.fixicon
	moveq #9,d0
	bsr.s .offset			; table des arbres
	move.l a0,a2			; pour les tables...
	move 22(a3),d0			; nombre d'arbres
	bra.s .lb5
.fixtree:
	add.l d3,(a0)+
.lb5:
	dbf d0,.fixtree
	moveq #5,d0
	bsr.s .offset			; table des chaŒnes libres (alertes)
	move 30(a3),d0			; nombre de chaines
	bra.s .lb8
.fixstr:
	add.l d3,(a0)+
.lb8:
	dbf d0,.fixstr
	moveq #8,d0
	bsr.s .offset			; table des images libres
	move 32(a3),d0			; nombre d'images
	bra.s .lb9
.fiximg:
	add.l d3,(a0)+
.lb9:
	dbf d0,.fixstr
	bra.s .ok
.offset:
	add.l d0,d0
	move 0(a3,d0.l),d0	; prend l'offset
	lea 0(a3,d0.l),a0		; a0 pointe sur le bon segment
	rts
.ok:
	moveq #1,d0
	lea intin,a0
	cmp.l #'FORT',(a0)
	bne.s .modif
	clr.l (a0)				; si FORT, ne pas modifier global, efface intin
	bra.s .sortie
.modif:
	lea global+10,a0
	move.l a2,(a0)+		; global+10 = table des adresses des arbres
	move.l a3,(a0)+		; global+14 = arbre RSC
	move 34(a3),(a0)		; global+18 = taille RSC
	bra.s .sortie
.erreur:
	moveq #0,d0
.sortie:
	move d0,intout
	rts
.extension:
	moveq #0,d0
	move 34(a3),d0
	move.l 4(a3,d0.l),d0		; offset vers l'extention
	lea 0(a3,d0.l),a2			; pointe sur une table vide … remplir !
	move.l a2,d6				; sauvegarde la table !
	move.l a2,a0
.ex0:
	tst.l (a0)+
	beq.s .ex0					; tant que pointeur nul, une icone de plus !
.ex1:
	move.l a0,(a2)+			; une icone trouv‚e, son adresse ICONBLK dans la structure
	move 22(a0),d0				; w
	muls 24(a0),d0				; w*h
	lsr.l #3,d0					; w*h/8 = nombre d'octets par plans !
	lea 34(a0),a1
	move.l (a1)+,d1			; combien d'icones en plus
	move.l a1,4(a0)			; data
	add.l d0,a1
	move.l a1,(a0)				; mask
	add.l d0,a1
	move.l a1,8(a0)			; text
	lea 12(a1),a0				; saute le texte
	bra.s .ex2
.exjump:
	move (a0)+,d2				; nombre de plans
	lea 20(a0),a1
	muls d0,d2					; octets par icone couleur
	move.l a1,(a0)+			; data
	add.l d2,a1
	move.l a1,(a0)+			; mask
	add.l d0,a1
	tst.l (a0)					; 1 si selected existe
	beq.s .ex5
	move.l a1,(a0)+			; data selected
	add.l d2,a1
	move.l a1,(a0)+			; mask selected
	add.l d0,a1
.ex5:
	move.l a1,a0
.ex2:
	dbf d1,.exjump
	tst.l (a2)					; -1 = fin de table ?
	beq.s .ex1					; on est sur une nouvelle ic“ne
	rts


; renvoie:
; work_out-10 / agi_intout+2 = 1 si multitache support‚
; work_out-8  / agi_intout+4 = 1 si appl_find fait le lien entre id mint et aes
; work_out-6  / agi_intout+6 = 1 si appl_search support‚
; work_out-4  / agi_intout+8 = 1 si rsrc_rcfix support‚

aes_info:
	cmp #$410,global
	bmi.s .rien
	GEM_AES _appl_getinfo 		; avec intin=4
.rien:
	rts

; flag n adr rsrc_mono
; n densit‚ trame, flag=1 alors adr=arbre, flag=0 alors adr=rsc complet
; si n=-1, la trame d'adapte … la luminosit‚ de la couleur

	SAUT
rsrc_mono:
	move.l (a6)+,a3			; arbre/rsc
	move.l (a6)+,d7			; densit‚
	bmi.s .lb1					; adapter … la couleur
	lsl.l #4,d7					; sinon, forcer densit‚ sur n
	and #$0070,d7				; ne garde que 3 bits
	or #$1100,d7				; couleur cadre & texte … 1
.lb1:
	tst.l (a6)+
	beq.s .rsc_complet
	move #-1,-(a6)				; marqueur de fin
	moveq #0,d5					; objet courant
.arbo:
	move d5,d0
	muls #24,d0
	lea 0(a3,d0.l),a2			; adresse de l'objet en cours
	bsr .modif_objet
	move d5,d0					; conserve
	move 2(a2),d5				; 1er enfant
	bmi.s .lb0
	move.l a2,-(a6)			; garde l'adresse du pŠre
	move d0,-(a6)				; l'objet a un enfant, on empile son rang pur fin de fratrie
	bra.s .arbo					; et on traite l'enfant
.lb0:
	move (a2),d5				; l'objet n'a pas d'enfant, on prend la valeur NEXT
	cmp (a6),d5					; fin de fratrie ?
	bne.s .arbo					; pas encore, on traite l'enfant suivant
	tst.w (a6)+					; d‚pile l'index et compare … -1
	bmi.s .fin
	move.l (a6)+,a2			; r‚cupŠre adresse du pŠre
	bra.s .lb0					; et va voir l'objet suivant
.fin:
	rts
.rsc_complet:
	moveq #0,d0
	move 2(a3),d0				; offset vers OBJ
	move 20(a3),d6				; nombre d'objets
	add.l d0,a3					; premier objet
	bra.s .rcloop
.autre:
	move.l a3,a2
	bsr.s .modif_objet
	lea 24(a3),a3
.rcloop:
	dbf d6,.autre
	rts
	; a2 = adr objet, d7 = densit‚ (laisser a2,a3,d5,d6,d7)
.modif_objet:
	move 6(a2),d0				; type
	lea 14(a2),a0				; mot couleur obspec
	cmp #20,d0
	beq.s .adapt				; BOX
	cmp #25,d0
	beq.s .adapt				; IBOX
	cmp #27,d0
	beq.s .adapt				; BOXCHAR
	move.l 12(a2),a1			; obspec
	lea 18(a1),a0				; mot couleur tedinfo
	cmp #21,d0
	beq.s .adapt				; TEXT
	cmp #22,d0
	beq.s .adapt				; BOXTEXT
	cmp #29,d0
	beq.s .adapt				; FTEXT
	cmp #30,d0
	beq.s .adapt				; FBOXTEXT
	lea 12(a1),a0				; mot couleur BITBLK ou ICONBLK
	cmp #23,d0
	beq.s .adapt				; IMAGE
	cmp #31,d0
	beq.s .adapti				; ICON
	cmp #33,d0
	bne.s .exit					; si pas CICON, rien … faire
.adapti:
	tst d7
	bpl.s .lb5					; si >0 mettre juste noir sur blanc
	moveq #0,d0
	moveq #0,d1
	move.b (a0),d0
	move d0,d1
	and #$f0,d0					; couleur 1er plan
	and #$f,d1					; fond
	lsr #3,d0
	add d1,d1
	move.w .noirceur(pc,d0.l),d0	; taux de noir 1er plan
	move.w .noirceur(pc,d1.l),d1	; taux de noir fond
	cmp d0,d1
	bmi.s .lb5					; moins de noirau fond, passer en noir sur banc
	move.b #$01,(a0)			; sinon, blanc sur noir
	bra.s .exit
.lb5:
	move.b #$10,(a0)			; pour les icones mono, noir sur blanc
	bra.s .exit
.adapt:
	move (a0),d0				; mot de couleur
	move d0,d1
	and #$80,d0					; garde transparence
	tst d7
	bmi.s .trame
	and #$F,d1					; couleur remplissage
	beq.s .lb2					; blanc, on garde
	addq #1,d0					; pour tous les autres, on passe au noir
.lb2:
	or d7,d0
	bra.s .lb3
.trame:
	move d1,d2
	and #$F,d2
	add d2,d2
	move .noirceur(pc,d2.w),d2		; taux de noir de la couleur
	lsr #4,d1					; motif
	and #7,d1
	muls d1,d2
	divs #1000,d2
	move d2,d1					; partie entiŠre du motif
	swap d2
	cmp #500,d2					; reste sup‚rieur … 500?
	bmi.s .lb4
	addq #1,d1					; arrondir au dessus
.lb4:
	lsl #4,d1
	or #$1101,d1				; 0001 0001 0mmm 0001	motif et couleur noire
	or d1,d0						; qu'on recolle avec la transparence
.lb3:
	move d0,(a0)				; et remplace le mot de couleur
.exit:
	rts
.noirceur:
	dc.w 0,1000,787,285		; densit‚ de noir par couleur / 1000
	dc.w 928,213,72,715
	dc.w 267,467,858,523
	dc.w 952,475,381,810


	SAUT
datetostr:
	move.l (a6)+,d1			; date aaaa aaam mmmj jjjj au format GEMDOS
	smi d2						; D2=FF si affichage 2 chiffres
	bpl.s .ok
	bclr #31,d1
.ok:
	lea pad+2,a0
	move.l a0,-(a6)
	move.l d1,d0
	and #$1F,d0					; jour
	bsr.s twodigits
	move.b #'/',(a0)+
	lsr.w #5,d1
	move.l d1,d0
	and #$F,d0					; mois
	bsr.s twodigits
	move.b #'/',(a0)+
	lsr.w #4,d1
	tst.b d2
	bne.s .2chiffres
	add #1980,d1
	divs #100,d1
	moveq #0,d0
	move d1,d0
	bsr.s twodigits			; le siŠcle
	clr d1
	swap d1						; les ann‚es
	bra.s .lb0
.2chiffres:
	sub #20,d1					; le reste au-dessus de 2000
	bpl.s .lb0					; si >0, ok
	add #100,d1					; sinon remet 80-99
.lb0:
	move.l d1,d0
	bsr.s twodigits
	clr.b (a0)
	tst langage
	bne.s .exit					; autre que US, on garde le format jj/mm/aa
	move.l (a6),a0
	lea 3(a0),a1
	move.b (a0),d0				; pour US, ‚change jj et mm
	move.b (a1),(a0)+
	move.b d0,(a1)+
	move.b (a0),d0
	move.b (a1),(a0)+
	move.b d0,(a1)+
.exit:
	rts

twodigits:
	divs #10,d0
	add.l #$00300030,d0
	move.b d0,(a0)+
	swap d0
	move.b d0,(a0)+
	rts

	SAUT
timetostr:
	move.l (a6)+,d1			; time hhhh hmmm mmms ssss au format GEMDOS
	lea pad+2,a0
	move.l a0,-(a6)
	rol #5,d1
	move.l d1,d0
	and #$1F,d0					; heures
	bsr.s twodigits
	move.b #':',(a0)+
	rol #6,d1
	move.l d1,d0
	and #$3F,d0					; minutes
	bsr.s twodigits
	move.b #':',(a0)+
	rol.w #5,d1
	move.l d1,d0
	and #$1F,d0
	add d0,d0					; secondes
	bsr.s twodigits
	clr.b (a0)
	rts

	SAUT
strtodate:
	move.l (a6)+,a0
	bsr.s twochar				; le jour (ou le mois US)
	move.l d0,d2
	bsr.s twochar				; le mois (ou le jour US)
	tst langage
	bne.s .lb2					; si <>0 c'est bien JJ puis MM
	exg.l d2,d0					; sinon on ‚change JJ et MM
.lb2:
	and #$1F,d2
	move.l d2,d7
	and #$F,d0
	lsl.l #5,d0
	or.l d0,d7
	bsr.s twochar				; l'ann‚e
	cmp #1980,d0
	bmi.s .lb0
	sub #1980,d0				; ann‚e sur 4 chiffres ramen‚e … offset+1980
	bra.s .comm
.lb0:
	cmp #80,d0
	bmi.s .lb1
	sub #80,d0					; ann‚e sur 2 chiffres 80-99 ramen‚e … offset+80
	bra.s .comm
.lb1:
	add.w #20,d0				; sinon, ann‚e sur 2 chiffres au dela de 2000
.comm:
	ror.w #7,d0
	or d0,d7
	move.l d7,-(a6)
	rts

twochar:
	moveq #0,d0
.again:
	moveq #0,d1
	move.b (a0)+,d1
	beq.s .fin
	cmp.b #':',d1
	beq.s .fin
	cmp.b #'/',d1
	beq.s .fin
	sub.b #'0',d1
	bmi.s .fin
	muls #10,d0
	add.l d1,d0
	bra.s .again
.fin:
	rts

	SAUT
strtotime:
	move.l (a6)+,a0
	bsr.s twochar				; les heures
	and #$1F,d0
	ror.w #5,d0
	move.l d0,d7
	bsr.s twochar				; les minutes
	and #$3F,d0
	lsl.l #5,d0
	or.l d0,d7
	bsr.s twochar				; les secondes
	lsr #1,d0					; sec/2
	and #$1f,d0
	or d0,d7
	move.l d7,-(a6)
	rts

julien:
	move.l (a6)+,a0
	bsr.s twochar
	move.l d0,d2				; jour
	bsr.s twochar
	move.l d0,d3				; mois
	bsr.s twochar				; d0 = ann‚e
	cmp #100,d0
	bpl.s .ok
	add #1900,d0				; pour les dates … 2 chiffres on corrige
	cmp #1980,d0
	bpl.s .ok					; si>1980 on considŠre que c'est bon
	add #100,d0					; sinon, ann‚es 2000
.ok:
	tst langage
	bne.s _julien				; si <>0 c'est bien JJ puis MM
	exg.l d2,d3					; sinon on ‚change JJ et MM
_julien:
	move.l d0,d4
	muls #365,d4					; 365A
	add.l d2,d4					; + J
	move.l d3,d2
	subq.l #1,d2
	muls #31,d2
	add.l d2,d4					; + 31(M-1)
	cmp #2,d3
	bpl.s .m2d
	subq.l #1,d0				; A=A-1 pour janv/fev
	bra.s .lb0
.m2d:
	lsl.l #2,d3					; 4M
	add.l #23,d3					; 4M+23
	divs #10,d3					; int(0,4M+2.3)
	swap d3
	clr d3
	swap d3
	sub.l d3,d4					; -...
.lb0:
	lsr.l #2,d0
	add.l d0,d4					; + int(A'/4)
	divs #25,d0					; A'/100
	addq.l #1,d0
	muls #3,d0
	lsr.l #2,d0
	sub.l d0,d4					; -int( 3/4*(int(A'/100)+1) )
	rts

	SAUT
ddate:
	bsr.s julien				; date de r‚f‚rence
	move.l d4,d5
	bsr.s julien				; date
	sub.l d5,d4					; ‚cart
	move.l d4,-(a6)			; renvoy‚
	rts

	SAUT
dofw:
	bsr.s julien				; date
	moveq #0,d0
	swap d4
	move d4,d0
	clr d4
	add.l d0,d0					; 65536 = 2(mod 7)
	swap d4
	add.l d4,d0
	divs #7,d0
	clr d0
	swap d0						; julien mod 7 (0=sam, 6=vend)
	move.l d0,-(a6)
	lea pad+2,a0
	lea .jours(pc),a1			; en fran‡ais
	tst langage
	bne.s .lb0
	lea .days(pc),a1			; ou en anglais
.lb0:
	bra.s .lb1
.lb2:
	tst.b (a1)+					; avance jusqu'au jour voulu
	bne.s .lb2
.lb1:
	dbf d0,.lb2
.lb3:
	move.b (a1)+,(a0)+		; et le copie dans pad
	bne.s .lb3
	rts
.jours: dc.b "Samedi",0,"Dimanche",0,"Lundi",0,"Mardi",0,"Mercredi",0,"Jeudi",0,"Vendredi",0
.days: dc.b "Saturday",0,"Sunday",0,"Monday",0,"Tuesday",0,"Wednesday",0,"Thursday",0,"Friday",0
	even

	SAUT
datep:
	move.l (a6)+,d5			; offset (+ ou -)
	bsr julien					; date
	add.l d4,d5					; la prochaine date !
	move.l d5,d7
	divs #365,d7					; ann‚e pr‚vue
	swap d7
	clr d7
	swap d7
.cherche_an:
	move.l d7,d0				; ann‚e
	moveq #1,d2					; 1er
	moveq #1,d3					; janvier
	bsr _julien
	cmp.l d4,d5
	dbpl d7,.cherche_an	; d‚cr‚mente ann‚e si valeur trop grande
	moveq #12,d6				; le mois
.cherche_mois:
	move.l d7,d0				; ann‚e
	moveq #1,d2					; 1er
	move.l d6,d3				; mois
	bsr _julien
	cmp.l d4,d5
	dbpl d6,.cherche_mois	; d‚cr‚mente le mois si trop
	sub.l d4,d5
	addq.l #1,d5				; jour !
	lea pad+2,a0
	move.l a0,-(a6)
	tst langage
	bne.s .ok
	exg.l d5,d6					; ‚change jour/mois
.ok:
	move.l d5,d0
	bsr twodigits
	move.b #'/',(a0)+
	move.l d6,d0
	bsr twodigits
	move.b #'/',(a0)+
	divs #100,d7
	moveq #0,d0
	move d7,d0
	bsr twodigits
	clr d7
	swap d7
	move.l d7,d0
	bsr twodigits
	clr.b (a0)
	rts
	rts

	COPIE tgetdate,tg1
tgetdate:
	GEMDOS 42,2
	move.l d0,-(a6)
tg1: rts

	COPIE tgettime,tg2
tgettime:
	GEMDOS 44,2
	move.l d0,-(a6)
tg2: rts

	COPIE tsetdate,tg3
tsetdate:
	move.l (a6)+,d1
	move d1,-(sp)
	GEMDOS 43,4
tg3: rts

   COPIE tsettime,tg4
tsettime:
	move.l (a6)+,d1
	move d1,-(sp)
	GEMDOS 45,4
tg4: rts

	NON		; non assemblable
thnext:
	move.l thhead,d3
	beq.s .main				; pas de liste de threads
	move.l thptr,d2		; pointeur vide?
	beq.s .main				; dans ce cas plus de threads
	move.l d2,a3
	bsr savecontext		; sauvegarde le thread en cours (a3)
.lb2:
	move.l kbshift,a0
	move.b (a0),d0
	and.b #$F,d0
	cmp.b #12,d0
	bgt.s .main				;si>12 alors ctrl+alt+shift, reprendre la main et quitter la boucle.
	move.l 10(a3),d2		; pointeur next
	bne.s .lb1				; non nul, thread suivant
	move.l d3,d2			; si nul, reprend la tˆte
.lb1:
	move.l d2,a3
	move.l d2,thptr		; actualise le pointeur
	moveq #0,d0
	move.b 17(a3),d0		; octet bas de STATE
	bpl.s .lb3				; si >0 pas en attente de synchro
	btst #6,d0				; sync main ?
	beq.s .lb2				; non, simple attente synchro, thread suivant
	lsr #4,d0
	and #3,d0				; isole tt
	lea thsynctab,a0
	tst.b 0(a0,d0)			; octet synchro arriv‚ … z‚ro?
	bne.s .lb2				; pas encore, passer au suivant
	bsr thsyncend			; sinon, synchro valid‚e
	move.l thptr,a3		; reprend le thread en cours (sync main)
	bra.s .lb4				; et on poursuit l'ex‚cution
.lb3:
	btst #0,d0				; bit0 de state = running ?
	beq.s .lb2				; non, thread suivant
.lb4:
	bsr loadcontext		; reprend le thread en cours
	rts
.main:
	clr.l thptr				; plus de thread en cours !
	lea thread0,a3
	bsr loadcontext
	rts

; A3 = adresse thread
; utilise A0/D0

savecontext:
	lea 18(a3),a0
	movem.l a4-a5,(a0)		; sauve a4,a5 courants
	addq.l #8,a0
	move base+2,(a0)+
	move handle,(a0)+
	move.l indptr,(a0)+
	move.l (a0),a0				; adresse pile
	move.l a6,d0
	sub.l a0,d0					; d‚calage
	move.l d0,(a0)				; met … jour la pile
	rts

; A3 = adresse thread

loadcontext:
	lea 18(a3),a0
	movem.l (a0)+,a4-a5
	move (a0)+,base+2
	move (a0)+,handle
	move.l (a0)+,indptr
	move.l (a0)+,a6
	move.l a6,pilbase
	add.l (a6),a6				; au cas o— la pile ait ‚t‚ modifi‚e par un autre
	move.l 4(a0),a0			; la page
	bsr _setp
	rts

; page pile param 'mot thread ou vthread

	SAUT
vthread:
	lea handle,a3
	move (a3),d6			; handle
	move 2(a3),d7			; i_handle
	move 4(a3),2(a3)		; g_handle dans i_handle
	GEM_VDI open_work
	move ow_cont+12,(a3)+; comme handle
	move d7,(a3)			; remet i_handle
	bsr.s thread			; cr‚e le thread
	move d6,handle			; et recolle mon handle
	move.l thhead,a3		; adresse de mon thread nouveau
	bset #1,17(a3)			; met le bit VDI ouvert dans state
	rts

	SAUT
thread:
	move.l #8+4658,d0
	bsr alloc
	move.l d0,a3			; adresse du bloc
	lea 8(a3),a0
	move.l a0,(a3)+		; pour respecter les structures dynamiques : adresse donn‚es
	move.l #4658,(a3)+	; taille donn‚es
	lea 46(a3),a1			; indice
	lea 4658(a3),a2		; pile retours
	move.l a2,d0
	and.b #$FC,d0
	move.l d0,a2			; pointeur A4 pile retours align‚ sur 4
	move.l thhead,d2
	move.l a3,a0			; pointeur A5
	move.l a3,thhead		; nouveau thread ins‚r‚ en tˆte
	move.l (a6)+,d0		; mot
	move d0,(a3)+			; code mot
	clr (a3)+				; code empile valeur
	move.l (a6)+,(a3)+	; Id
	move #518,(a3)+		; code thkill
	move.l d2,(a3)+		; next
	moveq #1,d0
	move.l d0,(a3)+		; state running
	move.l a2,(a3)+		; valeur A4 pile des retours
	move.l a0,(a3)+		; valeur A5 pointeur ex‚cution
	move base+2,(a3)+
	move handle,(a3)+
	move.l a1,(a3)+		; indptr
	move.l (a6)+,(a3)+	; pile base
	move.l a2,(a3)+		; retours base
	move.l (a6)+,(a3)+	; page
	rts


	; renvoie l'id du thread en cours
	COPIE thid,thid2,1
thid:
	move.l thptr,d1
	beq.s .exit				; pas de thread en cours, renvoie z‚ro
	move.l d1,a3			; current thread
	move.l 4(a3),d1		; prend son id
.exit:
	move.l d1,-(a6)
thid2:
	rts

; (a6)+ id … trouver
thfind:
	lea thhead,a3			; tˆte de chaŒne !
	move.l (a6)+,d0		; id a trouver
.lb0:
	move.l (a3),d1
	beq.s .non
	move.l d1,a0
	cmp.l 4(a0),d0
	beq.s .oui
	lea 10(a0),a3			; pointeur sur next
	bra.s .lb0
.oui:
	moveq #0,d0				; renvoie EQ, trouv‚ et A3 le pointeur
	rts
.non:
	moveq #1,d0				; renvoie NE, pas trouv‚
	rts

; id thpause
	NON
thpause:
	bsr thfind				; renvoie A3 l'adresse ou est stock‚ le pointeur vers ce thread
								; et EQ si ok ou NE si pas trouv‚
	bne.s .exit
	move.l (a3),a0			; le thread … pauser
	bclr #0,17(a0)			; efface bit running
	cmp.l thptr,a0			; est-ce le process en cours?
	beq thnext				; si oui, on passe la main !
.exit:
	rts

; id thkill
	NON
thkill:
	bsr thfind				; renvoie A3 l'adresse ou est stock‚ le pointeur vers ce thread
								; et EQ si ok ou NE si pas trouv‚
	bne.s .exit
	move.l (a3),a2			; le thread … pauser
	move.l 10(a2),a0		; le next du thread
	move.l a0,(a3)			; qui remplace ce thread mˆme, vir‚ de la chaŒne
	move.l a2,-(sp)		; sauve la valeur
	subq.l #8,a2			; revient sur la structure d'allocation
	bsr libere				; efface le bloc !
	move.l (sp)+,a2
	bsr.s thclosev
	cmp.l thptr,a2			; est-ce le process en cours?
	beq thnext				; si oui, on passe la main !
.exit:
	rts

; A2 adresse du thread … fermer

thclosev:
	btst #1,17(a2)			; bit v=VDI ouvert?
	beq.s .exit
	movem.l d0-d3/a0-a3,-(sp)
	lea i_handle,a3
	move (a3),d3			; sauve i_handle
	move 28(a2),(a3)		; met mon handle … fermer
	GEM_VDI close_work
	move d3,(a3)			; remet i_handle
	movem.l (sp)+,d0-d3/a0-a3
.exit:
	rts


; id thwake
	NON
thwake:
	bsr thfind
	bne.s .exit
	move.l (a3),a0			; le thread … r‚veiller
	bset #0,17(a0)			; met bit running
.exit:
	rts

; lance le multitƒche

	NON
thrun:
	move.l thhead,d0		; adresse tˆte
	beq.s .exit				; si vide, rien … faire
	lea thread0,a1
	move.l d0,10(a1)		; la tˆte comme next du thread mode direct
	moveq #0,d1				; nombre de process
.lb0:
	move.l d0,a0
	btst #0,17(a0)			; running?
	beq.s .lb1
	addq.l #1,d1			; compte les running
.lb1:
	move.l 10(a0),d0		; next
	bne.s .lb0				; pas fin de chaŒne, on continue
	tst.l d1					; des process?
	beq.s .exit				; non, on quitte
	move.l a1,thptr		; si oui, pointe sur THREAD0
	bra thnext				; et passe la main !
.exit:
	rts

init_thread0:
	moveq #0,d0
	move.l d0,thhead
	move.l d0,thptr
	lea thread0,a0
	move.l d0,(a0)+		; code mot+empile
	move.l d0,(a0)+		; valeur id
	move d0,(a0)+			; code thkill
	move.l d0,(a0)+		; next
	moveq #1,d0
	move.l d0,(a0)+		; state running
	addq.l #8,a0			; saute A4,A5
	move base+2,(a0)+
	move handle,(a0)+
	move.l indptr,(a0)+
	move.l pilbase,(a0)+
	move.l retptr,(a0)+
	move.l #fenetre0,(a0)+
	rts


	SAUT
thnsync:
	bsr.s thtab
	move.l (a6)+,d0
	move.b d0,(a0)
	rts

	SAUT
thsync:
	bsr.s thtab
	subq.b #1,(a0)			; un de moins … synchroniser
	move.l thptr,a0		; thread en cours
	lsl.b #4,d0				; 00tt0000 (avec valeur tableau)
	bset #7,d0				; s0tt0000 (synchro)
	move.b 17(a0),d1
	and.b #$0E,d1			; vire une ancienne synchro et le bit Run
	or.b d0,d1				; ajoute ma synchro
	move.b d1,17(a0)		; sauve STATE
	bra thnext				; passe la main !

thtab:
	move.l (a6)+,d0
	lea thsynctab,a0
	and.l #$00000003,d0
	add.l d0,a0				; adresse de l'octet qui va bien
	rts

	SAUT
thsyncmain:
	bsr.s thtab
	move.l thptr,a3		; thread en cours
	or.b #$0C,d0			; 0000smtt
	lsl.b #4,d0				; smtt0000 (avec valeur tableau)
	move.b 17(a3),d1
	and.b #$0E,d1			; vire une ancienne synchro et le bit Run
	or.b d0,d1				; ajoute ma synchro
	move.b d1,17(a3)		; sauve STATE
	subq.b #1,(a0)			; un de moins … synchroniser
	beq.s .sync
	bra thnext				; pas encore synchro, donc on passe la main
.sync:
	bsr.s thsyncend			; relance tous les threads en attente
	rts						; et poursuit dans ce thread

; parcourt toute la chaine et relance les threads
; ayant le mˆme tt que celui en cours

thsyncend:
	move.l thptr,a3		; le thread en cours
	move.b 17(a3),d0
	and.b #$30,d0			; isole tt
	move.l thhead,d2
.lb0:
	move.l d2,a3
	move.b 17(a3),d1		; STATE
	bpl.s .next				; bit SYNC absent, on passe
	move.b d1,d2
	and #$30,d2				; isole tt
	cmp.b d0,d2
	bne.s .next				; pas le mˆme indice
	and.b #$0F,d1			; efface la synchro
	bset #0,d1				; remet running
	move.b d1,17(a3)
.next:
	move.l 10(a3),d2
	bne.s .lb0
	rts

	SAUT
thkillall:
	lea thptr,a0
	move.l (a0),d7			; thread courant (ou z‚ro...)
	clr.l (a0)				; annule le pointeur
	lea thhead,a0
	move.l (a0),d2
	beq.s .exit
	clr.l (a0)				; annule pointeur chaŒne
.lb2:
	move.l d2,-(sp)
	move.l d2,a2
	cmp.l d2,d7				; thread en cours?
	bne.s .lb0
	move.l 34(a2),a0		; adresse pile
	move.l a6,d0
	sub.l a0,d0				; offset pile
	move.l d0,(a0)			; mis … jour
.lb0:
	subq.l #8,a2
	bsr libere
	move.l (sp)+,a2		; thread qu'on vient de fermer
	bsr thclosev			; en cas de station VDI ouverte, on la referme
	move.l 10(a2),d2		; next
	bne.s .lb2
.exit:
	tst.l d7
	bne thnext				; si on ‚tait dans un thread, va remettre le contexte thread0
	rts

	SAUT
thstat:
	lea thhead-10,a3
.lb0:
	move.l 10(a3),d7		; pointeur next
	beq.s .exit
	move.l d7,a3
	moveq #0,d0
	move (a3),d0			; le code du mot
	move.l d0,-(a6)
	bsr word
	jsr type					; affiche le mot
	move.l #'(',-(a6)
	jsr emit
	move.l 4(a3),-(a6)	; id
	if STE=0
		bsr pt					; affiche id
	else
		jsr pt
	endif
	lea .syn(pc),a0
	move.b 17(a3),d0
	bmi.s .synchro
	lea .run(pc),a0
	btst #0,d0
	bne.s .lb1
	lea .pau(pc),a0
	bra.s .lb1
.synchro:
	btst #6,d0
	beq.s .lb1
	lea .mai(pc),a0
.lb1:
	if STE=1
		jsr write_str
		jsr cr
	else
		jsr write_str
		bsr cr
	endif
	bra.s .lb0
.exit:
	rts
.run: dc.b ") Run",0
.pau: dc.b ") Pause",0
.syn: dc.b ") Sync",0
.mai: dc.b ") Sync Main",0
	even

; chaine 8 caractŠres exactement -> nom du player ACC
	SAUT
vd_set:
	GOSUB appl_find
	moveq #0,d0
	move intout,d0
	ext.l d0
	move.l d0,-(a6)
	move.l d0,vd_id
	rts

; " fichier" " option" vd_play
	SAUT
vd_play:
	st d4
	move.l (a6)+,a3		; chaine des options
	bra.s _vd_comm

; " fichier" vd_info
	SAUT
vd_info:
	sf d4						; flag info=00 et play=FF
_vd_comm:
	move.l (a6)+,a0		; chaine avec le nom du fichier
	lea vd_mesag,a1
	move.l topprg,a2		; pour cr‚er la ligne de commande
	move.l vd_id,-(a6)	; ID de M_PLAYER
	moveq #16,d0
	move.l d0,-(a6)		; 16 octets
	move.l a1,-(a6)		; buffer
	move.w #$4D50,(a1)+	; 'MP'
	move global+4,(a1)+	; mon ID
	clr (a1)+				; pas plus de 16 octets
	move.l a2,(a1)+		; ligne de commande
	move #'FO',(a1)+		; retour AES attendu
	clr.l (a1)+				; dum
	tst.b d4
	beq.s .info
.lb1:
	move.b (a3)+,(a2)+	; copie les options
	bne.s .lb1
	subq.l #1,a2
	bra.s .lb2
.info:
	move.w #' +',(a2)+
	move.w #'rl',(a2)+
	lea vd_retour,a1
	move.l a1,(a2)+	; cr‚e +rlxxxx
	move #-2,(a1)		; renvoie -2 si M_PLAYER n'a rien fait
.lb2:
	move.b #' ',(a2)+		; un espace entre options et fichier
.lb0:
	move.b (a0)+,(a2)+	; ajoute le fichier
	bne.s .lb0
	move.l d4,-(sp)
	bsr appl_write
	move.l (sp)+,d4
	tst.b d4
	bne.s .loop
	move.l #vd_retour,-(a6)
.loop:
	move.l #vd_mesag,-(a6)
	bsr evnt_mesag
	cmp #'FO',vd_mesag
	bne.s .loop
	rts

; 'routine zoom " output" o w h f k q s/t vd_create
; s= " sound file" avec adresse>65535
; ou bien t=time<65535
; zoom=$0101 ou $0201 ou $0102
; o=+8/+16 pour MOV 8/16 ou -8/-16 pour AVI 8/16
;  =+4/-4 pour DEGAS/NEO 16 couleurs
;  =1 pour DEGAS monochrome

	SAUT
vd_create:
	move.l topprg,a3
	lea .bat(pc),a2
	bsr .next
	move.l (a6)+,d0		; temps ou chaŒne son ?
	cmp.l #$10000,d0
	bmi.s .temps
	move.l d0,a0
	move.b #'s',-2(a3)	; change t= en s=
	bsr .add_str
	bra.s .lb0
.temps:
	bsr .add_int
.lb0:
	bsr .next
	move.l (a6)+,d0		; qualit‚ !
	bsr .add_int
	move.l (a6)+,d0		; key frames
	bne.s .lb1
	addq.l #5,a2			; si k=0, saute le paramŠtre
	bra.s .lb2
.lb1:
	bsr .next
	bsr .add_int
.lb2:
	move.l (a6)+,d4		; nombre dimages
	bsr .next
	move.l d4,d0
	bsr .add_int
	move.l (a6)+,d5		; h
	bsr .next
	move.l d5,d0
	bsr .add_int
	move.l (a6)+,d0		; w
	muls d0,d5				; nombre de pixels
	bsr .next
	bsr .add_int
	add.l d5,d5				; 16 bits
	moveq #18,d0
	add.l d5,d0				; plus header TGA
	bsr .next
	moveq #4,d2
	cmp.l (a6),d2
	beq.s .neo_dega
	neg.l d2
	cmp.l (a6),d2
	bne.s .lb33
.neo_dega:
	move.l #33000,d0		; pour degas et neo, c'est suffisant
.lb33:
	bsr .add_int			; taille buffer
	moveq #0,d2				; pas de caractŠre … ajouter par d‚faut
	move.l (a6)+,d0		; type de vid‚o demand‚e
	bpl.s .lb3				; si>0 MOV donc pas de caractŠre
	neg.l d0
	cmp #4,d0				; -4 si NEO
	bne.s .lb31
	move.l #'neoc',d1
	bra.s .lb4
.lb31:
	moveq #'#',d2			; si AVI 8
	cmp #8,d0
	beq.s .lb3
	moveq #'+',d2			; si AVI 16
.lb3:
	cmp #1,d0
	beq.s .lb34				; 1 si DEGAS monochrome
	cmp #4,d0				; 4 si DEGAS 16 couleurs
	bne.s .lb32
.lb34:
	move.l #'dega',d1
	bra.s .lb4
.lb32:
	move.l #'tga2',d1
	cmp #16,d0
	beq.s .lb4
	move.l #'ximg',d1
.lb4:
	bsr .next

	if STE=1

	swap d1
	rol #8,d1
	move.b d1,(a3)+		; c=
	rol #8,d1
	move.b d1,(a3)+
	swap d1
	rol #8,d1
	move.b d1,(a3)+		; c=
	rol #8,d1
	move.b d1,(a3)+

	else

	move.l d1,(a3)+

	endif

	bsr .next
	tst.b d2
	beq.s .lb5				; pas de caractŠre en plus
	move.b d2,(a3)+
.lb5:
	move.l (a6)+,a0
	bsr .add_str				; ajoute o=....
	bsr .next
	lea vd_dialog,a1
	move.l a1,d0
	bsr .add_int			; m=...
	tst.b signature
	beq.s .pas_copyright	; si byte nul, pas dechaine d‚finie
	lea signature-5(pc),a0
	bsr .add_str
	clr.b signature		; remet … z‚ro, n'est valable qu'une fois
.pas_copyright:
	bsr .next
	move.l d4,d0
	subq.l #1,d0			; r‚p‚ter une fois de moins (… cause de la premiŠre image)
	bsr .add_int			; rept f
	bsr .next				; fichier termin‚ !!!!
	move.l (a6)+,d0		; zoom
	move #'EX',12(a1)		; extension
	move d0,14(a1)			; et le zoom
	move.l (a6)+,d0		; code de la routine
	lsl.l #2,d0				; *4
	lea adresse,a0
	move.l 0(a0,d0.l),a0	; adresse routines
	addq.l #2,a0			; passe le code 437
	move.l a0,16(a1)		; et range l'adresse routine
	lea -20(a6),a0
	move.l a0,20(a1)		; A6 durant la routine
	move.l a4,24(a1)		; A4 durant la routine
	move.l #.ma_routine,(a1)	; la routine lan‡ant mon mot
	GEMDOS 25,2				; dgetdrv
	add.b #'A',d0
	lea .file(pc),a0
	move.b d0,(a0)			; le nom du lecteur !
	move.l a3,d0
	move.l topprg,a3
	sub.l a3,d0				; taille … ‚crire
	move.l d0,-(a6)
	move.l a0,-(a6)
	move.l a3,-(a6)
	bsr savebin				; sauvegarde le BAT
	move.l #.file,(a6)
	move.l #.option,-(a6)
	bra vd_play

.next:
	move.b (a2)+,(a3)+
	bne.s .next
	subq.l #1,a3
	rts
.add_int:
	if STE=1

	movem.l d3-d6/a1,-(sp)
	st ecran
	move.l d0,-(a6)
	jsr dpt
	sf ecran
	move.l a1,a0
	movem.l (sp)+,d3-d6/a1

	else

	lea 16(a3),a0
	clr.b (a0)
	moveq #10,d2
.lbx:
	divsl.l d2,d1:d0
	add.b #'0',d1
	move.b d1,-(a0)
	tst.l d0
	bne.s .lbx

	endif

.add_str:
	move.b (a0)+,(a3)+
	bne.s .add_str
	subq.l #1,a3
	rts

.bat:
	dc.b "m_player",13,10,"t=",0
	dc.b 13,10,"q=",0
	dc.b 13,10,"k=",0
	dc.b 13,10,"f=",0
	dc.b 13,10,"h=",0
	dc.b 13,10,"w=",0
	dc.b 13,10,"b=",0
	dc.b 13,10,"c=",0
	dc.b 13,10,"o=",0
	dc.b 13,10,"m=",0
	dc.b 13,10,"data",13,10,".getp",13,10,"F0000000.TGA",13,10,".rept ",0
	dc.b 13,10,".incr",13,10,".disp",13,10,".endr",13,10,".stop",13,10,0
.file:
	dc.b "X:\_FORTH.BAT",0
.option:
	dc.b "-d+a+e",0
	even

.ma_routine:
	lea vd_dialog+28,a0
	move.l -(a0),a4		; r‚cupŠre les pointeurs essentiels, pile retour
	move.l -(a0),a6		; pile donn‚es
	move.l -16(a0),-(a6)	; d‚pose sur la pile le nø de l'image (0 … f-1)
	move.l -(a0),a0		; adresse mot
	jmp (a0)					; on y saute !

	SAUT
vd_frame:
	lea vd_dialog+8,a0
	move.l (a6)+,d0		; flag
	move.l (a6)+,(a0)+	; adresse buffer
	move d0,(a0)			; flag (0 ou -1)
	rts

	SAUT
vd_sign:
	lea signature(pc),a0
	moveq #' ',d0
	moveq #30,d1
.lb0:
	move.b d0,(a0)+		; remplit d'espaces
	dbf d1,.lb0
	lea -31(a0),a0
	move.l (a6)+,a1		; le copyright utilisateur
	moveq #30,d1			; limit‚ … 32 caractŠres
.lb1:
	move.b (a1)+,d0		; un caractŠre
	beq.s .fin				; s'arrˆte si 0
	move.b d0,(a0)+		; sinon ajoute
	dbf d1,.lb1				; max 31
.fin:
	rts
	dc.b 13,10,"@=",34
signature: dc.b 255,"                              ",34,0
	even


; palvdi palxbios n pal2xbios
; si n n‚gatif, format ST 0-7, sinon format STE 0-F

	SAUT
pal2xbios:
	move #$0FFF,d7			; masque STE
	move.l (a6)+,d1		; nombre de couleurs
	bpl.s .lb0
	move #$0777,d7			; masque ST
	neg.l d1
.lb0:
	move.l (a6)+,a1		; destination XBIOS
	move.l (a6)+,a0		; souce VDI
	subq.l #1,d1			; index max
	lea .index4(pc),a2
	move.b d1,1(a2)		; y met le maximum

	move d1,d2				; pour la boucle !
	cmp #16,d2
	bmi.s .lb1
	moveq #15,d2
.lb1:
	bsr.s .une_couleur
	moveq #0,d0
	move.b (a2)+,d0		; table index VDI vers XBIOS
	add.l d0,d0
	move d6,0(a1,d0.l)	; range la couleur … sa place
	dbf d2,.lb1
	cmp #16,d1
	bmi.s .out
	move #238,d2			; couleurs 16 … 254
	lea 32(a1),a1
.lb2:
	bsr.s .une_couleur
	move d6,(a1)+
	dbf d2,.lb2
	bsr.s .une_couleur
	move d6,-240(a1)		; la 255Š revient sur la 15
.out:
	rts
.une_couleur:
	bsr.s .composante
	lsl #8,d0
	move d0,d6
	bsr.s .composante
	lsl #4,d0
	or d0,d6
	bsr.s .composante
	or d0,d6
	and d7,d6
	rts
.composante:
	moveq #0,d0
	move (a0)+,d0
	lsl.l #4,d0
	divs #1001,d0			; vdi*16/1001 donne de 0 … 15
	ror.b #1,d0
	lsl #1,d0
	lsl.b #4,d0
	lsr #5,d0				; mis au format xxxx3012
	rts
.index4: dc.b 0,15,1,2,4,6,3,5,7,8,9,10,12,14,11,13

; 'FN T t0 t1 n gr3_xyz(t)
	SAUT
gr3_xyzt:
	st gr_3d
	sf gr_type
	bra.s _xycomm

; 'FN T t0 t1 n gr_r(t)
	SAUT
gr_rt:
	sf gr_3d
	move.b #$7F,gr_type	; r(angle) = type 7F
	bra.s _xycomm


; 'FN X x0 x1 n gr_y(x)
	SAUT
gr_yx:
	sf gr_3d
	st gr_type				; y(x) = type FF
	bra.s _xycomm


; 'FN T t0 t1 n gr_xy(t)
	SAUT
gr_xyt:
	sf gr_3d
	sf gr_type				; x,y(t) = type 0
_xycomm:
	bsr init_plot
	move.l 24(a6),-(a6)	; code fonction
	bsr get_function
	move.l a1,24(a6)		; son adresse r‚elle
	move.l 20(a6),a1		; adresse var T (ou X)
	move.l 12(a6),(a1)+
	move.l 16(a6),(a1)	; stocke T0 dans T

	if STE=1					; partie STE

	move.l (a6)+,-(sp)	; valeur n ‚cart‚e
	bsr fover
	bsr fmoins				; t1-t0
	move.l (sp),-(a6)
	bsr intfl				; n en r‚el
	bsr fdiv					; dt = (t1-t0)/n
	move.l (sp)+,-(a6)	; r‚cupŠre n pour la boucle

	else						; partie FPU

	move.l (a6)+,d0		; conserve n
	fmove.d (a6)+,fp0		; t1
	fsub.d (a6),fp0		; ti-t0
	fdiv.l d0,fp0			; (t1-t0)/n
	fmove.d fp0,-(a6)		; sur la pile
	move.l d0,-(a6)		; et remet n !

	endif


.loop:
	move.l 24(a6),a0		; adresse de la fonction
	tst.b gr_type
	bpl.s .lb0				; si <0 on doit ajouter x sur la pile nous mˆme (cas y(x))
	move.l 16(a6),-(a6)
	move.l 16(a6),-(a6)	; copie x en cours sur la pile pour le type FF qui ne renvoie que y
.lb0:
	jsr (a0)					; calcule (x(t) et y(t)) ou y(x) ou rho(theta)
	tst.b gr_type
	ble.s .lb1				; type FF ou 00, on a d‚j… x,y
	bsr pol2rect			; sinon conversion polaire, rectangulaire !
.lb1:
	tst.b gr_3d
	beq.s .lb2
	bsr xyz_topage
	bra.s .lb3
.lb2:
	bsr xy_topage
.lb3:
	bsr xy_plot
	subq.l #1,(a6)
	bmi.s .exit

	if STE=1		; routine STE

	move.l (a6)+,-(sp)
	bsr fswap
	bsr fover
	bsr fplus
	bsr fswap
	move.l (sp)+,-(a6)
	move.l 20(a6),a1		; adresse var T
	move.l 12(a6),(a1)+
	move.l 16(a6),(a1)	; stocke Ti dans T

	else

	fmove.d 4(a6),fp0		; h
	fadd.d 12(a6),fp0		; t+h
	move.l 20(a6),a1		; adresse variable T
	fmove.d fp0,12(a6)	; nouvelle valeur sur la pile
	fmove.d fp0,(a1)		; et dans la variable

	endif

	bra.s .loop
.exit:
	lea 16(a4),a4			; efface les deux coefficents
	lea 28(a6),a6			; et tous les paramŠtres
	tst.b gr_3d
	beq.s .lb4
	addq.l #8,a4			; en 3d un coeff de plus sur la pile
.lb4:
	rts

; met le flag … 0
; calcule les deux coeffs et coefY en a4 et coefX en 8(a4)
; pr‚pare la fonction v_pline

init_plot:
	tst.b gr_3d
	beq.s .lb0
	bra init_plot3
.lb0:
	sf gr_plot				; 00 pour un premier point, FF si … relier au pr‚c‚dent
	bsr.s _calc_coeffs	; deux coefficients sur la pile des retours
_init_plot_comm:
	lea control,a0
	move #6,(a0)+
	move #2,(a0)+
	clr.l (a0)+
	clr.l (a0)+
	move handle,(a0)
	rts


_calc_coeffs:
	move.l fenetre,a0
	lea 28(a0),a1			; pointe sur xmax-xmin
	addq.l #4,a0			; pointe sur l
	bsr.s .coeff			; calcule (l-1)/(xmax-xmin)
	move.l fenetre,a0
	lea 44(a0),a1			; pointe sur ymin-ymax
	addq.l #6,a0			; poite sur h
	bsr.s .coeff			; calcule (h-1)/(ymin-ymax)
	rts
.coeff:
	if STE=1				; routine STE

	subq.l #8,a6
	move.l (a1)+,(a6)
	move.l (a1),4(a6)
	moveq #0,d0
	move (a0),d0
	subq #1,d0
	move.l d0,-(a6)
	bsr intfl
	bsr fswap
	bsr fdiv
	subq.l #8,a4			; pile des retours
	move.l (a6)+,(a4)
	move.l (a6)+,4(a4)	; stocke le coefficient

	else					; routine FPU

	moveq #0,d0
	move (a0),d0
	subq.l #1,d0
	fmove.l d0,fp0
	fdiv.d (a1),fp0
	fmove.d fp0,-(a4)

	endif

	rts

; y au sommet et x en dessous en REEL
; renvoie x ‚cran et y ‚cran en PTSIN+4/+6

xy_topage:
	bsr.s y_topage
	bsr.s x_topage
	rts

	if STE=1		; ici versions STE

y_topage:
	move.l fenetre,a0
	lea 40(a0),a0
	move.l (a0),-(a6)
	move.l -(a0),-(a6)
	bsr fmoins				; y-ymax
	move.l 4(a4),-(a6)
	move.l (a4),-(a6)
	bsr ffois				; (y-ymax)*coefY
	bsr flint				; en entier
	move.l (a6)+,d0		; y entier
	move.l fenetre,a0
	add 2(a0),d0			; plus offset page
	move.w d0,ptsin+6		; comme second point
	rts

x_topage:
	move.l fenetre,a0
	lea 24(a0),a0
	move.l (a0),-(a6)
	move.l -(a0),-(a6)
	bsr fmoins				; x-xmin
	move.l 12(a4),-(a6)
	move.l 8(a4),-(a6)
	bsr ffois				; (x-xmin)*coefX
	bsr flint				; en entier
	move.l (a6)+,d0
	move.l fenetre,a0
	add (a0),d0				; x+offset page
	move d0,ptsin+4		; comme second point
	rts

pol2rect:
	move.l 24(a6),-(a6)
	move.l 24(a6),-(a6)	; r‚cupŠre ti, l'angle
	bsr sincos				; R, sin, cos
	move.l (a6)+,d0
	move.l (a6)+,d1		; cos
	move.l 8(a6),d2
	move.l 12(a6),d3		; R
	bsr submul
	move.l 8(a6),d2
	move.l 12(a6),d3		; R
	move.l d0,8(a6)
	move.l d1,12(a6)		; range R*cos = x
	move.l (a6)+,d0
	move.l (a6)+,d1		; sin
	bsr submul
	move.l d1,-(a6)
	move.l d0,-(a6)		; range R*sin = y

;	bsr frot					; cos, R, sin
;	bsr fover				; cos, R, sin, R
;	bsr ffois				; cos, R, R*sin
;	bsr fsurr				; cos, R
;	bsr ffois				; R*cos
;	bsr rsurf				; R*cos, R*sin
	rts						; renvoie x et y !!

	else		; ici on utilise le FPU !

y_topage:
	move.l fenetre,a0
	fmove.d (a6)+,fp0
	fsub.d 36(a0),fp0		; y-ymax
	fmul.d (a4),fp0		; (y-ymax)*coefY
	fmove.l fp0,d0			; y entier
	add 2(a0),d0			; plus offset page
	move.w d0,ptsin+6		; comme second point
	rts

x_topage:
	move.l fenetre,a0
	fmove.d (a6)+,fp0
	fsub.d 20(a0),fp0		; x-xmin
	fmul.d 8(a4),fp0		; (x-xmin)*coefX
	fmove.l fp0,d0			; en entier
	add (a0),d0				; x+offset page
	move d0,ptsin+4		; comme second point
	rts

pol2rect:
	fsincos.d 20(a6),fp0:fp1	; r‚cupre ti, l'angle et sin en fp1, cos en fp2
	fmove.d (a6)+,fp2		; R
	fmul fp2,fp0
	fmove.d fp0,-(a6)		; Rcos = X
	fmul fp2,fp1
	fmove.d fp1,-(a6)		; Rsin = Y
	rts						; renvoie x et y !!

	endif

xy_plot:
	move.l ptsin+4,d0		; nouvel x,y
	move.l fenetre,a0
	movem.l (a0),d1-d2	; page x,y,l,h
	cmp d1,d0				; y et y page
	bmi.s .faux
	add d2,d1				; y et y+h page
	cmp d1,d0
	bpl.s .faux
	swap d0
	swap d1
	swap d2
	cmp d1,d0				; x et x page
	bmi.s .faux
	add d2,d1				; x et x+l page
	cmp d1,d0
	bpl.s .faux
	move.b gr_plot,d0		; ancien flag
	st gr_plot				; nouveau point Ok
	bra.s .plot
.faux:
	sf gr_plot
	bra.s xy_plotcut
.plot:
	tst.b d0
	beq.s xy_plotcut
	VDI
xy_plotcut:
	lea ptsin,a0
	move.l 4(a0),(a0)		; dernier point en premier point
	rts


; xmin xmax ymin ymax gr_window

	SAUT
gr_window:
	bsr fswap
	bsr fover
	bsr fmoins
	move.l fenetre,a0
	lea 36(a0),a0
	move.l (a6)+,8(a0)
	move.l (a6)+,12(a0)	; ymin-ymax
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)		; ymax
	bsr fover
	bsr fmoins
	move.l fenetre,a0
	lea 20(a0),a0
	move.l (a6)+,8(a0)
	move.l (a6)+,12(a0)	; xmax-xmin
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)		; xmin
	rts

; xmin xmax ymin ymax zmin zmax gr3_window

	SAUT
gr3_window:
	sf gr_view				; vue r‚initialis‚e
	sf gr_rot				; et rotation aussi
	move.l fenetre,a3
	lea 20(a3),a3
	move.b #3,gr_plot
.lb0:
	bsr fover
	bsr fmoins
	move.l (a6)+,(a3)+
	move.l (a6)+,(a3)+	; max-min
	move.l (a6)+,(a3)+
	move.l (a6)+,(a3)+	; min
	subq.b #1,gr_plot
	bne.s .lb0				; pour z, y et x successivement.
	rts

_fleche_init:
	moveq #0,d0
	move.l d0,-(a6)
	moveq #1,d0
	move.l d0,-(a6)
	bsr vsl_ends			; ligne avec fin en flŠche
	bsr init_plot			; calcule les coefficients
	rts

; gr_axes sans paramŠtre

	SAUT
gr_axes:
	sf gr_3d
	bsr.s _fleche_init
	clr.l -(a6)
	clr.l -(a6)				; x=0
	clr.l -(a6)
	clr.l -(a6)				; y=0
	bsr xy_topage			; coordonn‚es ‚cran de l'origine
	move.l fenetre,a0
	lea ptsin,a1
	move.l 4(a1),d1		; x0-y0
	move (a0),d0
	move d0,(a1)+			; x page
	move d1,(a1)+			; y0
	add 4(a0),d0
	subq #1,d0
	move d0,(a1)+			; x+l-1 page
	move d1,(a1)			; y0
	move.l d1,-(a6)		; sauve x0-y0
	st gr_plot				; valide le pr‚c‚dent point
	bsr xy_plot				; et ne v‚rifiera que le second.
	move.l fenetre,a0
	lea ptsin,a1
	move.l (a6)+,d1		; x0-y0
	swap d1
	move d1,(a1)			; x0
	move 2(a0),d0
	move d0,6(a1)			; y page
	add 6(a0),d0
	move d1,4(a1)			; x0
	subq #1,d0
	move d0,2(a1)			; y+h-1 page
	st gr_plot				; valide le pr‚c‚dent point
	bsr xy_plot				; et ne v‚rifiera que le second.
	lea 16(a4),a4			; efface les deux coefficents
_fleche_exit:
	moveq #0,d0
	move.l d0,-(a6)
	move.l d0,-(a6)
	bsr vsl_ends			; ligne avec fin normale
	rts

; xstep ystep g_grid

	SAUT
gr_grid:
	sf gr_3d
	moveq #3,d0
	move.l d0,-(a6)
	bsr vsl_type			; pointill‚s
	bsr init_plot
	move.l fenetre,a0
	lea ptsin,a1
	move (a0),d0			; x page
	move d0,(a1)
	add 4(a0),d0
	subq #1,d0
	move d0,4(a1)			; x+l-1 page
	lea 48(a0),a1
	bsr .first_line
.ligney:
	bsr fdup					; y
	bsr y_topage			; y en point ‚cran en PTSIN+6
	move.l fenetre,a0
	lea ptsin+2,a1
	move 4(a1),d0			; y ecran
	cmp 2(a0),d0
	bmi.s .finiy			; on a d‚pas‚ le haut de la page.
	bsr .line_and_step	; trace et avance
	bra.s .ligney
.finiy:
	lea 16(a6),a6			; vire y et ystep
	move.l fenetre,a0
	lea ptsin,a1
	move 2(a0),d0			; y page
	move d0,2(a1)
	add 6(a0),d0
	subq #1,d0
	move d0,6(a1)			; y+h-1 page
	lea 32(a0),a1
	bsr .first_line
	bchg #7,8(a6)			; -xstep car on revient en arriŠre
.lignex:
	bsr fdup					; x
	bsr x_topage
	lea ptsin,a1
	move.l fenetre,a0
	move 4(a1),d0			; x ecran
	cmp (a0),d0
	bmi.s .finix			; on a d‚pas‚ le bord gauche de la page.
	bsr .line_and_step	; trace et avance
	bra.s .lignex
.finix:
	lea 16(a6),a6			; vire x et xstep
	lea 16(a4),a4			; efface les deux coefficents
	moveq #1,d0
	move.l d0,-(a6)
	bsr vsl_type			; ligne continue
	rts
.first_line:
	move.l (a1),-(a6)
	move.l -(a1),-(a6)	; ymin-ymax (ou xmax-xmin)
	move.l -(a1),-(a6)
	move.l -(a1),-(a6)	; ymax (ou xmin)
	bsr fplus				; recalcule ymin (ou xmax)
	bsr fover				; ramŠne ystep((ou xstep)
	bsr fdiv
	bsr int
	bsr fover
	bsr ffois				; ystep * int(ymin / ystep), premiŠre ligne … tracer idem pour x
	rts
.line_and_step:
	move d0,(a1)
	move d0,4(a1)			; sinon complete les coordonn‚es de la ligne
	VDI						; trace !
	bsr fover				; ramŠne y/xstep
	bsr fplus				; ligne suivante
	rts

; n gr_getpoint	digitalise n points maxi sur la pile
	SAUT
gr_getpoint:
	sf gr_3d
	moveq #3,d0
	move.l d0,-(a6)
	bsr _wind_update		; r‚serve la souris
	bsr init_plot
	clr.b -2(a4)			; nombre de points empil‚s actuellement
	sf gr_plot				; flag=0, souris en dehors par d‚faut, curseur flŠche
	lea alert_getp+12,a0
	move.l (a6)+,d0		; "n"
	move.b #'0',(a0)+
	move.b #'0',(a0)
	move.b d0,gr_type		; -1 pas de limite, 0 pas de stack, >0 nombre max de points attendus
	beq.s .lb0				; si stack interdit, laisser 00
	addq.b #1,(a0)			; sinon, ‡a sera le point 01
.lb0:
	moveq #%110,d0
	move.l d0,-(a6)		; masque BUTTON + MOUSE
	moveq #1,d0
	move.l d0,-(a6)
	move.l d0,-(a6)
	move.l d0,-(a6)		; BUTTON 1 clic, appu‚ et bouton gauche
	moveq #0,d0
	move.b gr_plot,d0		; 0 si demande d'entr‚e, 1 si deande de sortie
	move.l d0,-(a6)		; flag
	move.l fenetre,a0
	movem.w (a0),d1-d4	; x,y,l,h
	move.l d1,-(a6)
	move.l d2,-(a6)
	move.l d3,-(a6)
	move.l d4,-(a6)
	moveq #0,d0
	move.l d0,-(a6)		; seconde zone inutile
	move.l d0,-(a6)
	move.l d0,-(a6)
	move.l d0,-(a6)
	move.l d0,-(a6)
	move.l d0,-(a6)		; temps=0
	move.l topprg,-(a6)	; here pour MESAG (nutilis‚)
	bsr evnt_multi
	move.b intout+1,-1(a4)	; sauve l'‚tat
	move.l intout+2,-6(a4)	; ainsi que les coordonn‚es
	btst #2,-1(a4)			; changement de zone?
	beq.s .lb2
	tst.b gr_plot
	beq.s .lb1				; on saute si c'est une entr‚e
	sf gr_plot				; sinon, une sortie
	clr.l -(a6)
	bsr graf_mouse			; curseur flŠche
	bra.s .lb0				; et n ignore les clics
.lb1:
	move.b #1,gr_plot		; ici une entr‚e
	moveq #5,d0
	move.l d0,-(a6)		; souris en croix
	bsr graf_mouse
.lb2:
	tst.b gr_plot
	beq .lb0					; si flag nul, on n'est pas dans la zone, ignorer
	btst #1,-1(a4)			; clic ?
	beq .lb0					; non
	move.l fenetre,a0
	move -6(a4),d0			; mousex
	sub (a0),d0				; mx-xpage
	ext.l d0
	move.l d0,-(a6)
	bsr intfl				; en float
	move.l 12(a4),-(a6)
	move.l 8(a4),-(a6)		; coefX
	bsr fdiv
	move.l fenetre,a0
	move.l 24(a0),-(a6)
	move.l 20(a0),-(a6)	; xmin
	lea alert_getp+21,a0
	bsr .affiche_reel
	move.l fenetre,a0
	move -4(a4),d0			; mousey
	sub 2(a0),d0			; my-ypage
	ext.l d0
	move.l d0,-(a6)
	bsr intfl				; en float
	move.l 4(a4),-(a6)
	move.l (a4),-(a6)	; coefY
	bsr fdiv
	move.l fenetre,a0
	move.l 40(a0),-(a6)
	move.l 36(a0),-(a6)	; ymax
	lea alert_getp+52,a0
	bsr .affiche_reel
	sf gr_plot				; remet le flag … "dehors"
	clr.l -(a6)
	bsr graf_mouse			; curseur flŠche
	moveq #3,d0
	move.l d0,-(a6)		; bouton3 = RETURN
	move.l #alert_getp,-(a6)
	bsr form_alert
	move intout,d0
	subq #1,d0
	beq.s .empiler
.non:
	lea 16(a6),a6			; d‚pile x et y
	subq #1,d0				; ruse depuis '.empiler"
	bne .lb0
.exit:
	moveq #0,d0
	move.b -2(a4),d0
	move.l d0,-(a6)		; nombre de points empil‚s
	lea 16(a4),a4			; nettoie la pile retours
	moveq #2,d0
	move.l d0,-(a6)
	bsr _wind_update		; libŠre la souris
	rts
.empiler:
	move.b gr_type,d0		; paramŠtre n
	beq.s .non				; empilement interdit si =0
	addq.b #1,-2(a4)		; un point de plus
	lea alert_getp+13,a0
	addq.b #1,(a0)
	cmp.b #'9'+1,(a0)
	bne.s .lb5
	move.b #'0',(a0)
	addq.b #1,-(a0)
.lb5:
	tst.b d0
	bmi .lb0					; empilement sans limite si -1
	cmp.b -2(a4),d0		; limite atteinte?
	beq.s .exit				; oui, on quitte automatiquement
	bra .lb0					; sinon retour
.affiche_reel
	move.l a0,-(sp)
	bsr fplus				; (mx-xpage)/coefX + xmin = coordonn‚e r‚elle x
	bsr fdup
	bsr subaff
	lea affbuf,a1
	move.l (sp)+,a0
	moveq #26,d0
.lb7:
	move.b (a1)+,(a0)+
	dbeq d0,.lb7
	bne.s .lb8
	subq.l #1,a0
.lb9:
	move.b #' ',(a0)+
	dbf d0,.lb9
.lb8:
	rts

	SAUT
; %fx %fy %fz gr_plot
gr3_plot:
	st gr_3d
	bsr.s _plot_comm
	addq.l #8,a4		; un coeff de plus … virer
	rts

_init_marker:
	bsr init_plot
	lea control,a0
	addq #1,(a0)+		; transforme polyline en polymarker
	subq #1,(a0)		; et un seul couple de points
	rts


; %fx %fy gr_plot		affiche une marque (selon v_pmarker)
   SAUT
gr_plot2:
	sf gr_3d
_plot_comm:
	bsr.s _init_marker
	tst.b gr_3d
	beq.s .lb0
	bsr xyz_topage
	bra.s .lb1
.lb0:
	bsr xy_topage		; coordonn‚es vers ‚cran
.lb1:
	bsr xy_plotcut		; ramŠne x,y en premier point
	st gr_plot			; valide le trac‚
	bsr xy_plot
	lea 16(a4),a4		; efface les coefficients
	rts

; 'FN x %fa %fb %ferr maximum ou minimum

	SAUT
minimum:
	st gr_type			; FF pour -f(x)
	bra.s _extremum

	SAUT
maximum:
	sf gr_type
_extremum:
	moveq #-2,d0
	move.l d0,-(a6)
	bsr ffois2				; erreur/2
	bclr #7,(a6)			; en valeur absolue
	movem.l (a6)+,d0-d1	; erreur max
	movem.l d0-d1,-(sp)	; sur la pile
	bsr fover
	bsr fover
	bsr fmoins				; a-b
	bclr #7,(a6)			; abs(b-a)
	moveq #-2,d0
	move.l d0,-(a6)
	bsr ffois2				; h=(b-a)/4 et h>0 toujours
	movem.l (a6)+,d0-d1	; h
	movem.l d0-d1,-(sp)	; sur la pile
	bsr fplus				; a+b
	moveq #-1,d0
	move.l d0,-(a6)
	bsr ffois2				; C=(a+b)/2
	movem.l (a6)+,d0-d1	; C
	movem.l d0-d1,-(sp)	; sur la pile
	move.l (a6)+,a0		; adresse variable
	move.l a0,-(sp)		; sur la pile
	movem.l d0-d1,(a0)	; X=C
	bsr get_function		; adresse fonction
	move.l a1,-(sp)		; sur la pile.
	jsr (a1)					; calcule f(c)
	tst.b gr_type
	beq.s .lb2
	bchg #7,(a6)			; -f(x) pour minimum
.lb2:
	movem.l (a6)+,d0-d1	; F(C)
	movem.l d0-d1,-(sp)	; sur la pile.

			 ; pile SP = 0 F(C) , 8 FN, 12 X, 16 C, 24 h, 32 err

.iteration:
	moveq #-1,d0
	bsr .calcul				; met X=C-h et laisse sur la pile F(X)
	tst.l (a6)+
	beq.s .lb0
	bsr .store				; si F(C-h)>F(C), alors C-h est le nouveau centre
	bra.s .new_h
.lb0:
	addq.l #8,a6			; vire F(x)
	moveq #0,d0
	bsr .calcul				; met X=C+h et laisse sur la pile F(x)
	tst.l (a6)+
	beq.s .lb1
	bsr .store				; si F(C+h)>F(C) alors C+h est le nouveau centre
	bra.s .new_h
.lb1:
	addq.l #8,a6			; sinon, C reste inchang‚, vire F(x)
.new_h
	lea 28(sp),a0
	move.l (a0),-(a6)
	move.l -(a0),-(a6)	; copie h
	moveq #-1,d0
	move.l d0,-(a6)
	bsr ffois2				; divise h par 2
	lea 24(sp),a0
	move.l (a6),(a0)+
	move.l 4(a6),(a0)+	; range h
	move.l 4(a0),-(a6)
	move.l (a0),-(a6)		; r‚cupŠre "erreur"
	bsr fsup					; compare h et erreur
	tst.l (a6)+
	bne.s .iteration		; h>erreur, on continue
	lea 28(sp),a0
	move.l (a0),-(a6)
	move.l -(a0),-(a6)	; renvoie h
	moveq #1,d0
	move.l d0,-(a6)
	bsr ffois2				; finalement 2h pour l'intervalle
	lea 40(sp),sp			; nettoie la pile
	rts
.calcul:
			 ; pile SP = 4 F(C) , 12 FN, 16 X, 20 C, 28 h, 36 err
	lea 32(sp),a0
	move.l (a0),-(a6)
	move.l -(a0),-(a6)	; h
	tst d0
	beq.s .cc0
	bchg #7,(a6)			; -h
.cc0:
	lea 24(sp),a0
	move.l (a0),-(a6)
	move.l -(a0),-(a6)	; C
	bsr fplus				; c+/-h
	move.l 16(sp),a0		; adresse de x
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)		; x=c+/-h
	move.l 12(sp),a0		; adresse fonction
	jsr (a0)					; f(x)
	tst.b gr_type
	beq.s .cc1
	bchg #7,(a6)			; pour minimum : -f(x)
.cc1:
	bsr fdup					; F(X)
	lea 8(sp),a0
	move.l (a0),-(a6)
	move.l -(a0),-(a6)	; F(C)
	bsr fsup					; is F(X)>F(C) ?
	rts
.store:
	lea 4(sp),a0
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)		; stocke F(x) sur F(C)
	move.l 16(sp),a0		; adresse de X
	lea 20(sp),a1			; adresse de X
	move.l (a0)+,(a1)+
	move.l (a0),(a1)		; et X dans C
	rts

	if STE=1					; routines STE

init_plot3:
	move.l fenetre,a2
	lea 24(a2),a2
	lea coeff3d(pc),a3
	move.b #3,gr_plot
.lb0:
	bsr.s .one
	lea 20(a2),a2
	subq.b #1,gr_plot
	bne.s .lb0
	bra _init_plot_comm	; initialise v_pline
.one:
	move.l (a3)+,-(a6)
	move.l (a3)+,-(a6)	; le coef
	move.l (a2),-(a6)
	move.l -(a2),-(a6)	; max-min
	bsr fdiv
	move.l (a6)+,-(a4)	; coeff rang‚ invers‚
	move.l (a6)+,-(a4)
	rts

coeff3d: 					; mots longs invers‚s k=1/(1+sqr(2)/2)
	dc.l $33018868,$BFE2BEC3	; -k	pour Z
	dc.l $33018868,$3FE2BEC3	; k	pour Y
	dc.l $99FCEF33,$3FDA8279	; 1-k	pour X

xyz_topage:
	move.b gr_view,d7
	bra.s .lb0
.lb1:
	bsr frot
	subq.b #1,d7
.lb0:
	bne.s .lb1
_xyz_topage:						; ici pour axes et grille, pas besoin d'adapter
	move.l fenetre,a3
	lea 20(a3),a3
	move.l 12(a3),-(a6)
	move.l 8(a3),-(a6)			; zmin
	bsr fmoins
	move.l 16(a4),-(a6)
	move.l 20(a4),-(a6)			; coefZ
	bsr ffois
	bsr frot
	move.l 28(a3),-(a6)
	move.l 24(a3),-(a6)			; ymin
	bsr fmoins
	move.l 8(a4),-(a6)
	move.l 12(a4),-(a6)			; coefY
	bsr ffois
	bsr fswap
	move.l 44(a3),-(a6)
	move.l 40(a3),-(a6)			; xmin
	bsr fmoins
	move.l (a4),-(a6)
	move.l 4(a4),-(a6)			; coefX
	bsr ffois
	bsr fswap
	bsr fover
	bchg #7,(a6)					; -x
	bsr fplus						; y-x
	lea coeff3d+16(pc),a0
	move.l (a0)+,-(a6)
	move.l (a0)+,-(a6)			; 1-k
	bsr fplus						; y-x+1-k (valeur X de 0 … 1)
	lea -20(a3),a3					; retour fenetre
	moveq #0,d0
	move 4(a3),d0					; w
	move.l d0,-(a6)
	bsr intfl
	bsr ffois
	bsr flint
	move.l (a6)+,d0
	add (a3),d0						; + x page
	move d0,ptsin+4				; sauve x ‚cran
	bsr fplus						; z+x
	lea coeff3d+8(pc),a0
	move.l (a0)+,-(a6)
	move.l (a0)+,-(a6)			; k
	bsr fplus						; z+x+k (valeur Y de 0 … 1)
	moveq #0,d0
	move 6(a3),d0					; h
	move.l d0,-(a6)
	bsr intfl
	bsr ffois
	bsr flint
	move.l (a6)+,d0
	add 2(a3),d0					; +y page
	move d0,ptsin+6				; sauve y ‚cran
	rts

	else					; ici le FPU !

init_plot3:
	move.l fenetre,a2
	sf gr_plot
	lea 20(a2),a2
	lea coeff3d(pc),a3
	bsr.s .one
	bsr.s .one
	bsr.s .one
	bra _init_plot_comm	; initialise v_pline
.one:
	fmove.d (a3)+,fp0		; le coef
	fdiv.d (a2),fp0		; divis‚ par max-min
	lea 16(a2),a2			; pr‚pare le prochain
	fmove.d fp0,-(a4)		; coeff rang‚
	rts

coeff3d: 					; mots longs k=1/(1+sqr(2)/2)
	dc.l $BFE2BEC3,$33018868	; -k	pour Z
	dc.l $3FE2BEC3,$33018868	; k	pour Y
	dc.l $3FDA8279,$99FCEF33	; 1-k	pour X

xyz_topage:
	move.b gr_view,d7
	bra.s .lb0
.lb1:
	bsr frot
	subq.b #1,d7
.lb0:
	bne.s .lb1
_xyz_topage:						; ici pour axes et grille, pas besoin d'adapter
	move.l fenetre,a3
	lea 20(a3),a3
	fmove.d (a6)+,fp0				; z
	fmove.d (a6)+,fp1				; y
	fmove.d (a6)+,fp2				; x

	fsub.d 8(a3),fp0				; z-zmin
	fsub.d 24(a3),fp1			; y-ymin
	fsub.d 40(a3),fp2				; x-xmin

	fmul.d (a4),fp2				; fois coefX
	fmul.d 8(a4),fp1				; fois coefY
	fmul.d 16(a4),fp0				; fois coefZ

	fsub fp2,fp1					; y-x
	fadd fp2,fp0					; z+x

	fadd.d coeff3d+8(pc),fp0	; z+x+k (valeur Y de 0 … 1)
	fadd.d coeff3d+16(pc),fp1	; y-x+1-k (valeur X de 0 … 1)

	lea -20(a3),a3					; retour fenetre

	fmul.w 4(a3),fp1				; foix w
	fmul.w 6(a3),fp0				; fois h

	fmove.l fp1,d0					; valeur entiŠre
	fmove.l fp0,d1					; valeur entiŠre

	add (a3),d0						; + x page
	add 2(a3),d1					; + y page
	swap d0
	move d1,d0

	move.l d0,ptsin+4				; sauve x,y ‚cran
	rts

	endif

	SAUT
gr3_axes:
	st gr_3d
	bsr _fleche_init
	moveq #4,d1
	moveq #20,d0
	bsr.s .min_max		; (0,0,zmin) … (0,0,zmax)
	moveq #2,d1
	moveq #36,d0
	bsr.s .min_max		; (0,ymin,0) … (0,ymax,0)
	moveq #0,d1
	moveq #52,d0
	bsr.s .min_max
	bsr _fleche_exit
	lea 24(a4),a4		; vire les coefficents
	rts
.annule:
	clr.l -(a6)
.annule2:
	dbf d1,.annule
	rts
.min_max:
	move.l d1,-(sp)
	bsr.s .annule2
	move.l fenetre,a3
	add.l d0,a3
	move.l 4(a3),-(a6)
	move.l (a3),-(a6)				; max-min
	move.l 12(a3),-(a6)
	move.l 8(a3),-(a6)			; min
	bsr fplus						; recalcule max
	moveq #4,d1
	bsr.s .annule2					; deux coordonn‚es nulles
	move.l 12(a3),-(a6)
	move.l 8(a3),-(a6)			; min
	moveq #4,d1
	sub.l (sp)+,d1
	bsr.s .annule2
	bsr _xyz_topage					; le point min de l'axe
	sf gr_plot
	bsr xy_plot
	bsr _xyz_topage					; le point max (vers la flŠche)
	bsr xy_plot
	rts


	SAUT
gr3_grid:
	st gr_3d
	moveq #5,d0
	move.l d0,-(a6)
	bsr vsl_type			; tirets
	bsr init_plot
	bsr.s .max				; recalcule les maxima
	lea .table(pc),a2
	bra.s .end_loop
.loop:
	move.l fenetre,a3
	lea 68(a3),a0			; fin de xmin, le max ‚tant toujours en 24(a6)
	tst.b (a2)+
	bmi.s .end_loop
	bsr.s .one
	lea 52(a3),a0			; ymin
	tst.b (a2)+
	bsr.s .one
	lea 36(a3),a0			; zmin
	tst.b (a2)+
	bsr.s .one
	move.l a2,-(sp)		; pr‚cieux !
	bsr _xyz_topage
	bsr xy_plot_force
	move.l (sp)+,a2
	bra.s .loop
.end_loop:
	tst.b (a2)
	bmi.s .exit
	sf gr_plot
	bra.s .loop
.exit:
	lea 24(a4),a4
	lea 24(a6),a6
	sf gr_3d
	moveq #1,d0
	move.l d0,-(a6)
	bsr vsl_type			; ligne continue
	rts
.one:
	beq.s .min
	lea 24(a6),a1			; max
	move.l -(a1),-(a6)
	move.l -(a1),-(a6)
	rts
.min:
	move.l -(a0),-(a6)
	move.l -(a0),-(a6)
	rts
.max:
	move.b #3,gr_type
	move.l fenetre,a3
	lea 68(a3),a3
.mm0:
	move.l -(a3),-(a6)
	move.l -(a3),-(a6)	; min
	move.l -(a3),-(a6)
	move.l -(a3),-(a6)	; max-min
	bsr fplus				; recalcule max
	subq.b #1,gr_type
	bne.s .mm0
	rts
.table:
	dc.b 1,0,0,1,0,1,0,0,1,0,1,1,0,1,0,1,1,0,1,0,0,0,0,0,0,1,0,-1
	dc.b 0,0,0,0,0,1,-1
	dc.b -1
	even

xy_plot_force:
	move.l ptsin+4,d0		; nouvel x,y
	move.l fenetre,a0
	movem.l (a0),d1-d2	; page x,y,l,h
	cmp d1,d0				; y et y page
	bpl.s .ok1
	move d1,d0
.ok1:
	add d2,d1				; y et y+h page
	cmp d1,d0
	bmi.s .ok2
	subq #1,d1
	move d1,d0
.ok2:
	swap d0
	swap d1
	swap d2
	cmp d1,d0				; x et x page
	bpl.s .ok3
	move d1,d0
.ok3:
	add d2,d1				; x et x+l page
	cmp d1,d0
	bmi.s .ok4
	subq #1,d1
	move d1,d0
.ok4:
	swap d0
	move.l d0,ptsin+4		; actualise les coordonn‚es
	tst.b gr_plot
	beq.s .out
	VDI
.out:
	st gr_plot
	bra xy_plotcut

; n gr3_view (n=0 xyz, n=1 zxy, n=2 yzx, n<0 demande la valeur)
	SAUT
gr3_view:
	moveq #0,d6
	moveq #3,d5
	move.b gr_view,d6
	move.l (a6)+,d7
	bpl.s .lb0
	move.l d6,-(a6)	; si n‚gatif, on renvoie la valeur en cours
	rts
.lb0:
	move.l fenetre,a3
	lea 20(a3),a3
	cmp.l d5,d7
	bmi.s .lb1
	moveq #0,d7			; plus de 2, on revient … z‚ro
.lb1:
	cmp.l d6,d7
	beq.s .exit			; si valeur atteinte, cool, on sort
	movem.l (a3),d0-d3	; sinon,r‚cupŠre Z
	lea 16(a3),a0
	moveq #7,d4
.lb2:
	move.l (a0)+,(a3)+	; copie Y,X sur Z,Y
	dbf d4,.lb2
	movem.l d0-d3,(a3)	; et Z sur X
	lea -32(a3),a3
	addq.l #1,d6		; une rotation faite
	cmp.l d5,d6
	bmi.s .lb1			; moins de 3, ‡a va
	moveq #0,d6			; sinon retour … z‚ro
	bra.s .lb1
.exit:
	move.b d6,gr_view
	rts

	; 'fn x y n gr_area

	SAUT
gr_area:
	moveq #1,d0			; le point
	move.l d0,-(a6)
	bsr vsm_type		; fixe la marque au point
	sf gr_3d
	bsr _init_marker		; la zone, les coeffs et v_pmarker
	move.l 12(a6),-(a6)	; code fonction
	bsr get_function
	move.l a1,12(a6)		; range l'adresse de la fonction
	move.l fenetre,a0
  	lea 4(a0),a2			; L
   lea 32(a0),a0			; xmax-xmin
  	move.l (a6),d0			; n
   bsr .dx_dy
	lea ptsin,a0
	clr.l 4(a0)				; comptage du nombre de points test‚s
	clr.l 8(a0)				; comptage du nombre de points colori‚s (pour calculer l'aire!)
	move (a0)+,(a0)		; sauve loopx dans ptsin+2
	move.l fenetre,a0
	lea 6(a0),a2			; H
	lea 48(a0),a0			; ymin-ymax
	move.l 8(a6),d0		; n
	bsr .dx_dy
	lea ptsin+2,a0
	clr -(a6)
	move (a0),-(a6)		; loopx
	move -(a0),-(a6)
	clr -(a6)				; stocke loopy

	move.l fenetre,a0
	move 2(a0),ptsin+2	; et initialise l'ordonn‚e ‚cran … Y page
	lea 36(a0),a0			; ymax
	move.l 28(a6),a1		; adresse variable Y
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+	; stocke ymax dans Y, valeur de d‚part
.boucle_lignes:
	move.l fenetre,a0
	move (a0),ptsin		; et initialise l'abscisse ‚cran … X page
	lea 20(a0),a0			; xmin
	move.l 32(a6),a1		; adresse variable X
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+	; stocke xmin dans X, valeur de d‚part
	move 4(a6),6(a6)		; et loopx remis
.boucle_points:
	move.l 36(a6),a0
	jsr (a0)					; calcule la fonction qui renvoie 0 (faux) ou autre (vrai)
	lea ptsin+4,a0
	addq.l #1,(a0)+		; un point de plus dans le total
	tst.l (a6)+
	beq.s .suite
	addq.l #1,(a0)			; un point de plus colori‚
	VDI						; si vrai, marque un point
.suite:
	subq #1,6(a6)			; d‚cr‚mente loopx
	bmi.s .fin_ligne
	if STE=1
   	lea 20(a6),a0			; dx
	   move.l 32(a6),a3		; variable X
	   bsr.s .inc_xy
	else
		fmove.d 16(a6),fp0
		move.l 32(a6),a3
		fadd.d (a3),fp0
		fmove.d fp0,(a3)
   endif
	move 26(a6),d0			; n
	add d0,ptsin			; point suivant
	bra.s .boucle_points
.fin_ligne:
	subq.l #1,(a6)			; loopy
	bmi.s .fin_ecran
	if STE=1
   	lea 12(a6),a0			; dy
	   move.l 28(a6),a3		; variable Y
   	bsr.s .inc_xy
   else
   	fmove.d 8(a6),fp0
   	move.l 28(a6),a3
   	fadd.d (a3),fp0
   	fmove.d fp0,(a3)
   endif
	move 26(a6),d0
	add d0,ptsin+2			; ligne suivante
	bra .boucle_lignes

	if STE=1
.inc_xy:
	   move.l (a0),-(a6)
	   move.l -(a0),-(a6)	; dx/dy
	   move.l 4(a3),-(a6)
	   move.l (a3),-(a6)		; valeur variable
	   bsr fplus
	   move.l (a6)+,(a3)+
	   move.l (a6)+,(a3)+	; met … jour la variable
   	rts
	endif
.fin_ecran:
	move.l fenetre,a0
	if STE=1
   	lea 52(a0),a0
	   move.l -(a0),-(a6)
   	move.l -(a0),-(a6)	; ymin-ymax
	   subq.l #8,a0
   	move.l -(a0),-(a6)
	   move.l -(a0),-(a6)	; xmax-xmin
   	bsr ffois					; calcule l'aire totale
	   bclr #7,(a6)			; en valeur absolue
   	move.l ptsin+8,-(a6)	; points colori‚s
	   bsr intfl
   	bsr ffois					; aire * interieur
	   move.l ptsin+4,-(a6)
   	bsr intfl
	   bsr fdiv					; aire * interieur/total - aire colori‚e
   	move.l 32+8(a6),a1	; variable X
	   move.l (a6)+,(a1)+	; retourne l'aire dans X
	   move.l (a6)+,(a1)+
	else
		fmove.d 44(a0),fp0
		fmul.d 28(a0),fp0
		lea ptsin+8,a0
		fabs fp0
		fmul.l (a0),fp0
		fdiv.l -(a0),fp0
   	move.l 32(a6),a1	; variable X
   	fmove.d fp0,(a1)
   endif
	lea 16(a4),a4			; vide coeffs
	lea 40(a6),a6			; vide pile
	rts
.dx_dy:
	moveq #0,d1
	move (a2),d1
	divs d0,d1
	move d1,ptsin			; calcule loopx = L/n
	if STE=0
   	fmove.d -4(a0),fp0
   	fmul.l d0,fp0
   	fdiv.w (a2),fp0
   	fmove.d fp0,-(a6)
   else
   	move.l (a0),-(a6)
	   move.l -(a0),-(a6)	; xmax-xmin
   	move.l d0,-(a6)		; n
	   bsr intfl
   	bsr ffois				; n*(xmax-xmin)
	   moveq #0,d0
   	move (a2),d0			; L
	   move.l d0,-(a6)
   	bsr intfl
	   bsr fdiv					; n*(xmax-xmin)/L - dx (et pareil pour dy)
	endif
	rts

; 'fn x y n gr3_z(xy)f

	SAUT
gr3_zxyf:
	clr.l -(a6)
	bsr vsf_interior
	moveq #1,d0
	move.b d0,gr_type					; type 1 = surface couleur de fond et contour
	move.l d0,-(a6)
	bsr vsf_perimeter
	bsr _init_ligne
	bra.s _zxy_comm
; topprg sera organis‚ ainsi:
; 0	x,y pr‚c‚dent
; 4	x,y, actuels
; 8	x,y point -1 (inexistant mais n‚cessaire)
; 12	x,y point 0
; 16	x,y point 1
; ...
;		x,y, point n




; 'fn x y n gr3_z(xy)l

	SAUT
gr3_zxyl:
	sf gr_type					; type 0 = lignes sans traits cach‚s
_zxy_comm:
	st gr_3d
	bsr init_plot3
	move.l 12(a6),-(a6)
	bsr get_function
	move.l a1,12(a6)			; la fonction !
	move.l fenetre,a0
	move.l (a6)+,d0			; n
	move.l (a6)+,-(a4)		; Y
	move.l (a6),a1				; X
	lea 60(a0),a0
	move.l (a0)+,(a1)+
	move.l (a0),(a1)			; X = xmin
	move.l d0,-(a4)
	subq.l #8,a0
	bsr .init_xy
	move.l (a4)+,d0			; n
	move.l (a4)+,-(a6)		; Y
	move.l fenetre,a0
	lea 40(a0),a0
	bsr .init_xy				; pile n %fdy Y n %fdx X fn
	tst.b gr_rot
	beq.s .boucle_x
	bsr .init_rot				; si une rotation est pr‚vue, fait les modifications
.boucle_x:
	move.l fenetre,a0
	move.l 12(a6),a1			; Y
	lea 44(a0),a0
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+		; Y= ymin
	sf gr_plot					; coupure de ligne
	move 2(a6),(a6)			; remet n pour Y
	tst.b gr_rot
	beq.s .boucle_y
	bsr .init_ymin				; remet le y minimal

.boucle_y:
	move.l 32(a6),a0			; fonction
	move.l 28(a6),a1
	move.l 12(a6),a2
	move.l 4(a1),-(a6)
	move.l (a1),-(a6)			; d‚pose X
	move.l 4(a2),-(a6)
	move.l (a2),-(a6)			; d‚pose Y
	jsr (a0)						; d‚pose Z
	bsr xyz_topage
	tst.b gr_type
	beq.s .lignes				; type 0, que des lignes
	bsr surface				; sinon, trac‚ de surfaces
	bra.s .autre
.lignes:
	bsr xy_plot
.autre:
	subq #1,(a6)
	bmi.s .fin_ligne
	lea 12(a6),a0
	bsr.s .inc_xy
	tst.b gr_rot
	beq.s .boucle_y
	bsr .inc_yrot
	bra.s	.boucle_y
.fin_ligne:
	subq.l #1,16(a6)
	bmi.s .fin
	tst.b gr_type
	beq.s .rien				; si type 0, ne rien changer
	bsr prepare_ligne
.rien:
	lea 28(a6),a0
	bsr.s .inc_xy
	tst.b gr_rot
	beq .boucle_x
	bsr .inc_xrot
	bra .boucle_x
.fin:
	lea 36(a6),a6
	lea 24(a4),a4
	rts

	if STE=1

.init_xy:
	move.l (a0),-(a6)
	move.l -(a0),-(a6)		; taille X ou Y
	move.l d0,-(a6)			; n
	move.l d0,-(a4)
	jsr intfl
	bsr fdiv						; taille/n - dx ou dy
	move.l (a4)+,-(a6)		; remet n
	rts
.inc_xy:
	move.l (a0),a1				; la variable
	move.l 4(a1),-(a6)
	move.l (a1),-(a6)			; valeur sur la pile
	move.l -(a0),-(a6)
	move.l -(a0),-(a6)		; dx ou dy sur la pile
	bsr fplus
	move.l (a6)+,(a1)+		; nouvel X+dx ou Y+dy dans la variable
	move.l (a6)+,(a1)+
	rts

.fois_sincos:
	lea gr3_angle+16,a3
	move.l -(a3),-(a6)
	move.l -(a3),-(a6)		; sin
	move.l 4(a0),-(a6)
	move.l (a0),-(a6)			; dx ou dy
	move.l -(a3),-(a6)
	move.l -(a3),-(a6)		; cos
	move.l 4(a0),-(a6)
	move.l (a0),-(a6)			; dx ou dy
	bsr ffois					; d*cos
	bsr frot
	bsr ffois					; d*sin
	lea gr3_angle,a3
	rts
.init_rot:
	lea 4(a6),a0				; pointe sur dy
	bsr.s .fois_sincos
	bchg #7,(a6)				; fnegate
	lea 16(a3),a3
	move.l (a6)+,(a3)+
	move.l (a6)+,(a3)+		; -dy*sin
	move.l (a6)+,(a3)+
	move.l (a6)+,(a3)+		; dy*cos
	lea 20(a6),a0				; pointe sur dx
	bsr.s .fois_sincos
	lea 40(a3),a3
	move.l (a6)+,(a3)+
	move.l (a6)+,(a3)+		; dx*cos
	lea -16(a3),a0
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)+		; dx*sin
	move.l 12(a6),(a3)+		; adresse Y
	move.l 28(a6),a1
	move.l a1,(a3)+			; adresse X
	move.l a3,12(a6)			; fake y
	addq.l #8,a3
	move.l a3,28(a6)			; fake x
	move.l (a1),(a3)+
	move.l 4(a1),(a3)+		; remplit fake x avec xmin
	move.l a1,-(sp)
	lea gr3_angle+4,a1		; le cos
	lea 8(a1),a2				; le sin
	bchg #7,-4(a2)				; -sin
	bsr.s .matrice
	movem.l (a6)+,d0-d1
	move.l (sp)+,a1
	movem.l d0-d1,(a1)		; dans ma variable originale
	movem.l d0-d1,gr3_angle+80	; garder le xmin
	lea gr3_angle+12,a1		; le -sin
	bchg #7,-4(a1)				; +sin
	lea -8(a1),a2				; le cos
	bsr.s .matrice
	lea gr3_angle+72,a3
	move.l (a6)+,(a3)+
	move.l (a6)+,(a3)+
	rts
.matrice:
	move.l fenetre,a0
	move.l 64(a0),-(a6)
	move.l 60(a0),-(a6)		; xmin
	move.l (a1),-(a6)
	move.l -(a1),-(a6)		; sin ou cos
	move.l 48(a0),-(a6)
	move.l 44(a0),-(a6)		; ymin
	move.l (a2),-(a6)
	move.l -(a2),-(a6)		; cos ou sin
	bsr ffois
	bsr frot
	bsr ffois
	bsr fplus					; xcos-ysin ou xsin+ycos
	rts


.inc_yrot:
	lea gr3_angle,a3
	move.l 52(a3),a0
	move.l 4(a0),-(a6)
	move.l (a0),-(a6)			; X
	move.l 20(a3),-(a6)
	move.l 16(a3),-(a6)		; -dy*sin
	bsr fplus
	lea gr3_angle,a3
	move.l 52(a3),a0
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)+		; rang‚ dans X
	move.l 48(a3),a0
	move.l 4(a0),-(a6)
	move.l (a0),-(a6)			; Y
	move.l 28(a3),-(a6)
	move.l 24(a3),-(a6)		; dy*cos
	bsr fplus
	lea gr3_angle,a3
	move.l 48(a3),a0
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)+		; rang‚ dans Y
	rts
.inc_xrot:
	lea gr3_angle,a3
	move.l 84(a3),-(a6)
	move.l 80(a3),-(a6)		; Xmin
	move.l 36(a3),-(a6)
	move.l 32(a3),-(a6)		; dx*cos
	bsr fplus
	lea gr3_angle,a3
	movem.l (a6)+,d0-d1
	movem.l d0-d1,80(a3)		; nouvel xmin
	move.l 52(a3),a0
	movem.l d0-d1,(a0)		; et rang‚ dans vax x
	rts

	else

.init_xy:
	fmove.d -4(a0),fp0
	fdiv.l d0,fp0
	fmove.d fp0,-(a6)
	move.l d0,-(a6)
	rts
.inc_xy:
	move.l (a0),a1				; la variable
	fmove.d (a1),fp0
	fadd.d -8(a0),fp0
	fmove.d fp0,(a1)
	rts
.init_rot:
	lea gr3_angle,a3
	fmove.d (a3)+,fp2			; cos
	fmove.d (a3)+,fp3			; sin
	fmove.d 4(a6),fp0			; dy
	fmove fp0,fp1
	fmul fp3,fp0				; dy*sin
	fmul fp2,fp1				; dy*cos
	fneg fp0						; -dy*sin
	fmove.d fp0,(a3)+
	fmove.d fp1,(a3)+
	fmove.d 20(a6),fp0		; dx
	fmove fp0,fp1
	fmul fp2,fp0				; dx*cos
	fmul fp3,fp1				; dx*sin
	fmove.d fp0,(a3)+
	fmove.d fp1,(a3)+
	move.l 12(a6),(a3)+		; adresse Y
	move.l 28(a6),a1
	move.l a1,(a3)+			; adresse X
	move.l a3,12(a6)			; fake y
	addq.l #8,a3
	move.l a3,28(a6)			; fake x
	move.l (a1),(a3)+
	move.l 4(a1),(a3)+		; remplit fake x avec xmin
	move.l fenetre,a0
	fmove.d 60(a0),fp0		; xmin
	fmove.d 44(a0),fp1		; ymin
	fmove fp0,fp4
	fmul fp2,fp4
	fmove fp1,fp5
	fmul fp3,fp5
	fsub fp5,fp4				; xmin*cos-ymin*sin = nouvel xmin
	fmove.d fp4,(a1)			; dans ma variable X originale
	fmul fp3,fp0
	fmul fp2,fp1
	fadd fp1,fp0				; xmin*sin+ymin*cos - nouvel ymin
	fmove.d fp0,(a3)+			; dans mon stockage pour chaque ligne
	fmove.d fp4,(a3)			; idem !
	rts
.inc_yrot:
	lea gr3_angle,a3
	move.l 52(a3),a0
	fmove.d (a0),fp0			; X
	fadd.d 16(a3),fp0			; X-dy*sin
	fmove.d fp0,(a0)			; rang‚
	move.l 48(a3),a0
	fmove.d (a0),fp0			; Y
	fadd.d 24(a3),fp0			; Y+dy*cos
	fmove.d fp0,(a0)			; rang‚
	rts
.inc_xrot:
	lea gr3_angle,a3
	fmove.d 80(a3),fp0		; Xmin
	fadd.d 32(a3),fp0			; X+dx*cos
	fmove.d fp0,80(a3)		; rang‚
	move.l 52(a3),a0			; varx
	fmove.d fp0,(a0)
	rts



	endif


.init_ymin:
	lea gr3_angle+72,a0		; pointe sur le nouvel ymin
	move.l gr3_angle+48,a1	; adresse Y original
	move.l (a0)+,(a1)+
	move.l (a0)+,(a1)+
	rts


surface:
	bgt.s .premiere_ligne
	sf gr_plot					; pas de ligne !
	bsr xy_plot					; mais teste quand mˆme
	moveq #-1,d0				; par defaut invalide
	tst.b gr_plot
	beq.s .lb0					; c'‚tait le cas
	move.l ptsin,d0			; sinon, point actuel
.lb0:
	move.l topprg,a1
	move.l 4(a1),d1			; point ex-actuel
	move.l d1,(a1)+			; qui devient pr‚c‚dent
	move.l d0,(a1)				; et actuel mis … jour
	lea ptsin,a0
	move.l d1,(a0)+
	bmi.s .invalide
	move.l d0,(a0)+
	bmi.s .invalide
	move.l surfptr,a2
	move.l (a2),(a0)+
	bmi.s .invalide
	move.l -(a2),(a0)
	bmi.s .invalide
	VDI
.invalide:
	move.l topprg,a0
	move.l surfptr,a2
	move.l (a0),-4(a2)		; et met … jour le point pr‚c‚dent dans la liste sauvegard‚e.
	addq.l #4,surfptr
	rts
.premiere_ligne:				; pour la 1ere ligne, on la trace
	bsr xy_plot
	move.l surfptr,a0
	tst.b gr_plot
	beq.s .nul
	lea ptsin,a1
	move.l (a1)+,(a0)+		; point conserv‚ si flag OK
	bra.s .ok
.nul:
	moveq #-1,d0
	move.l d0,(a0)+			; point invalide (-1) si flag NO
.ok:
	move.l a0,surfptr
	rts
prepare_ligne:
	bmi.s .dernier_a_jour	; toujours le test sur gr_type d'avant l'appel
	st gr_type					; si >0, c'est le premier passage, on met … -1
	move.l #$00090004,control	; change v_pline en v_fillarea avec 4 points
	bra.s _init_ligne
.dernier_a_jour:
	move.l surfptr,a1				; pointe sur le dernier point
	move.l topprg,a0
	move.l 4(a0),-4(a1)				; copie le dernier point dans la liste sauvegard‚e.
_init_ligne:
	move.l topprg,a0
	moveq #-1,d0
	move.l d0,(a0)+				; point pr‚c‚dent dummy invalide
	move.l d0,(a0)+				; point actuel invalide (pour l'instant)
	move.l d0,(a0)+				; point "-1" de la ligne savegard‚e invalide
	move.l a0,surfptr
	rts

	SAUT
gr3_rot:
	movem.l (a6),d0-d1
	tst.l d0
	bne.s .valid
	tst.l d1
	bne.s .valid
	sf gr_rot				; pas d'angle
	addq.l #8,a6			; vire le z‚ro de la pile
	rts
.valid:
	jsr sincos
	lea gr3_angle,a0
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)+	; le cosinus
	move.l (a6)+,(a0)+
	move.l (a6)+,(a0)+	; le sinus
	st gr_rot				; angle valid‚
	rts

	SAUT
torad:
	move.l #$a2529d38,-(a6)
	move.l #$3f91df46,-(a6)
	bra ffois					; fois pi/180

	SAUT
todeg:
	move.l #$1a63c1f8,-(a6)
	move.l #$404ca5dc,-(a6)
	bra ffois					; fois 180/pi


	SAUT
bstr:
	move.l (a6)+,a0			; chaine source
	lea pad+2,a1				; chaine destination
	move.l a1,-(a6)			; renvoy‚e comme adresse dest
.lb0:
	move.b (a0)+,d0
	beq.s .fin
	cmp.b #':',d0
	bne.s .lb1
	cmp.b #':',(a0)			; doubl‚? c'est lui meme
	beq.s .double
	; ici code hexa sur 2 caractŠres exactement
	moveq #1,d2
.hexa:
	move.b (a0)+,d1
	beq.s .fin
	cmp.b #'a',d1
	blt.s .h1
	sub.b #32,d1				; a-f -> A-F
.h1:
	cmp.b #'A',d1
	blt.s .h2
	subq.b #7,d1				; A-F to 10-15
.h2:
	sub.b #'0',d1				; 0-15 to 00 0F
	lsl.b #4,d0
	or.b d1,d0
	dbf d2,.hexa
	bra.s .lb2
.lb1:
	cmp.b #'.',d0
	bne.s .lb2
	cmp.b #'.',(a0)
	beq.s .double				; doubl‚, c'est lui meme
	; ici code d‚cimal sur 3 octets maxi
	moveq #0,d0
	moveq #2,d2
.decimal:
	move.b (a0)+,d1
	beq.s .recule
	cmp.b #'9',d1
	bhi.s .recule				; ce n'est plus un chiffre!
	sub.b #'0',d1
	bmi.s .recule				; la non plus
	muls #10,d0
	add.b d1,d0					; sinon ajoute un chiffre
	dbf d2,.decimal			; limit‚ … 3 caractŠres
	bra.s .lb2
.recule:
	subq.l #1,a0				; on a fini le d‚cimal
	bra.s .lb2
.double:
	addq.l #1,a0
.lb2:
	move.b d0,(a1)+			; range l'octet
	bra.s .lb0					; suite !
.fin:
	clr.b (a1)					; ajoute un z‚ro terminal, ‡a peut servir
	sub.l (a6),a1				; nombre d'octets ‚crits
	move.l a1,-(a6)			; sur la pile !
	rts

	SAUT
getfile:
	move.l (a6)+,a0			; chaine chemin+fichier
	lea pad+2,a1				; destination, le fichier
	move.l a1,-(a6)			; valeur renvoy‚e
	move.l a0,a2				; retient le dernier \ ou :
.lb0:
	move.b (a0)+,d0
	beq.s .lb1					; fin de chaine
	cmp.b #'\',d0
	beq.s .lb2
	cmp.b #':',d0
	bne.s .lb0
.lb2:
	move.l a0,a2				; met a jour position
	bra.s .lb0
.lb1:
	move.b (a2)+,(a1)+		; copie le nom de fichier
	bne.s .lb1
	rts

	SAUT
getpath:
	move.l (a6)+,a0			; chaine chemin+fichier
	lea pad+2,a1				; destination, le chemin
	move.l a1,-(a6)			; valeur renvoy‚e
	move.l a1,a2				; retient le dernier \ ou :
.lb0:
	move.b (a0)+,d0
	move.b d0,(a1)+
	beq.s .lb1					; fin de chaine
	cmp.b #'\',d0
	beq.s .lb2
	cmp.b #':',d0
	bne.s .lb0
.lb2:
	move.l a1,a2				; met a jour position
	bra.s .lb0
.lb1:
	clr.b (a2)					; termine le chemin au d‚but du nom de fichier
	rts

	SAUT
getradio:
	move.l (a6)+,a0			; arbre
	move.l (a6)+,d0			; index du BOX
	moveq #0,d1
	moveq #24,d2
	muls d0,d2
	move 2(a0,d2.l),d2		; premier enfant
	bmi.s .exit					; si n‚gatif, pas d'enfant
.lb0:
	move d2,d1
	muls #24,d2
	btst #4,9(a0,d2.l)		; radiobutton?
	beq.s .lb1
	btst #0,11(a0,d2.l)		; et selected?
	bne.s .exit
.lb1:
	move 0(a0,d2.l),d2		; le suivant
	cmp d2,d0					; retour sur le box d'origine?
	bne.s .lb0
.exit:
	move.l d1,-(a6)
	rts

	; appel‚ par gem_list et par rsc2for
	; a0 = adresse options
	; sur la pile en 4(sp) adresse des possibilit‚s
	; utilise d0,d1,d2,a1
	; renvoie d6 = masque d'options

gemlist_options:
	moveq #0,d6					; flags
.lb0:
	move.b (a0)+,d0			; un caractŠre
	beq.s .lb1					; fin options
	and.b #$DF,d0				; majuscule
	move.l 4(sp),a1			; les optiosn possibles
	moveq #-1,d1				; num‚ro de bit
.lb2:
	addq.l #1,d1				; bit suivant
	move.b (a1)+,d2			; une option
	beq.s .lb0					; fin!
	cmp.b d2,d0
	bne.s .lb2
	bset d1,d6
	cmp.b #12,d0				; la virgule?
	bne.s .lb2					; non, on continue, sinon elle met fin … la recherche
.lb1:
	move.l (sp)+,(sp)
	rts
	; 0  A = arrows (les flŠches)
	; 1  S = lignes s‚lectionnables et exit
	; 2  E = lignes ‚ditables FTEXT
	; 3  B = border ajoute un contour
	; 4  , = signale la pr‚sence d'une suite de chaines … initialiser dans gem_list
	; 31 si fonte rectangulaire (boutons deux fois plus larges)
glst_opt: dc.b "ASEB",12,0	; 12 = 44 (virgule) and $DF pour majuscule
win_opt: dc.b "NCFMISUDVLRH",0
	even

	SAUT
gemlist:
	move.l (a6)+,a0			; adresse des options
	pea glst_opt(pc)
	bsr gemlist_options
	move.l (a6)+,d5			; n = nombre de chaŒnes
	move.l (a6)+,d4			; l = longueur d'une chaŒne
	move.l (a6)+,a3			; adresse 1ere chaine
	move.l topprg,a0			; dictionnaire
	move.l a0,-(a6)			; pour le retour
	move.l a6,a1				; pour modifier avec d6/d5 sauv‚s
	btst #2,d6					; champs ‚ditables..?
	beq.s .lb3					; non !
	move.l d4,d0
	move.l a0,-(a6)			; la chaine masque
.lb4:
	move.b #'_',(a0)+
	dbf d0,.lb4
	clr.b -1(a0)
	move.l a0,-(a6)			; la chaine validation
	move.l d4,d0
.lb5:
	move.b #'X',(a0)+
	dbf d0,.lb5
	clr.b -1(a0)
	move.l a0,d0
	addq.l #1,d0
	bclr #0,d0
	move.l d0,a0
	lea 8(a6),a1				; pointe sur l'adresse retour
.lb3:
	move.b d6,(a0)+			; conserve les options (bits 0-3)
	move.b d5,(a0)+			; ainsi que le nombre de chaines	(limit‚ … 255...)
	move.l a0,(a1)				; ‚crit le nouveau d‚but d'arbre sur la pile
	move.l d5,d0				; n
	addq.l #1,d0				; + le BOX du cadre
	btst #0,d6
	beq.s .lb6					; pas de boutons
	addq.l #3,d0				; sinon 3 objets en plus!
.lb6:
	muls #24,d0					; taille de la zone OBJETS
	move.l a0,-(a6)			; adresse objets
	add.l a0,d0					; vers zone suivante
	btst #2,d6
	bne.s .lb7					; il y a des FTEXT !
	clr.l -(a6)					; pas de tedinfo
	bra.s .lb8
.lb7:
	moveq #28,d1
	muls d5,d1					; taille zone TEDINFO
	move.l d0,-(a6)			; adresse tedinfo
	add.l d1,d0					; fin dictionnaire
.lb8:
	move.l d0,topprg			; nouvelle fin dicco
	clr.l -(a6)					; pas d'images
	bsr dialogue				; initie le dialogue
	move large(pc),d0
	cmp haut(pc),d0
	beq.s .lb8b
	bset #31,d6					; si fonte pas carr‚e
.lb8b:
	clr.l -(a6)					; flag
	clr.l -(a6)					; state
	move.l #$00001100,d0		; cadre vide
	btst #3,d6
	beq.s .lb8c
	move.l #$00021100,d0		; avec contour
.lb8c:
	move.l d0,-(a6)	; obspec
	clr.l -(a6)					; x
	clr.l -(a6)					; y
	move.l d4,d0
	btst #0,d6
	beq.s .lb8a
;	addq.l #1,d0				; si buttons, une colonne de plus
	add #$0201,d0				; une colonne et deux pixels de plus
	btst #31,d6
	beq.s .lb8a
	addq.l #1,d0				; si fonte rectangulaire, deux colonnes
.lb8a:
	add #$0400,d0				; + 4 pixels de large
	move.l d0,-(a6)			; w
	move.l d5,d0
	add #$0400,d0
	move.l d0,-(a6)			; h
	moveq #20,d1				; BOX
	moveq #0,d7
	movem.l a3/d4-d6,-(sp)
	bsr xylh						; cr‚e l'objet z‚ro !
	movem.l (sp)+,a3/d4-d6
	clr.l -(a6)
	bsr child					; commence la liste des enfants du BOX
	btst #0,d6					; boutons?
	beq.s .lb9
	moveq #5,d7
	move.l #$01FF1100,d0
	moveq #0,d2
	moveq #1,d3
	moveq #27,d1
	bsr .box						; BOXCHAR flŠche haut
	moveq #5,d7
	move.l #$02FF1100,d0
	move.l d5,d2
	subq.l #1,d2
	moveq #1,d3
	moveq #27,d1
	bsr .box						; BOXCHAR flŠche bas
	moveq #0,d7
	move.l #$00FF1141,d0
	moveq #1,d2
	move.l d5,d3
	subq.l #2,d3
	moveq #20,d1				; BOX gris entre les deux boutons
	bsr .box
.lb9:
	moveq #0,d7					; position 1ere ligne
	btst #2,d6					; lignes ‚ditables?
	bne .lb10
	bra.s .lb11
.lb12:
	moveq #0,d0
	btst #1,d6					; selectable?
	beq.s .lb13
	moveq #5,d0
.lb13:
	move.l d0,-(a6)			; flag
	clr.l -(a6)					; state
	move.l a3,-(a6)			; adresse chaŒne
	move.l #$00000200,-(a6)	; x=0+2 pixels
	move.l d7,d0
	add #$0200,d0
	move.l d0,-(a6)			; y + 2 pixels
	move.l d4,-(a6)			; l
	moveq #1,d0
	move.l d0,-(a6)			; h
	moveq #28,d1				; STRING
	movem.l a3/d4-d7,-(sp)
	moveq #0,d7
	bsr xylh
	movem.l (sp)+,a3/d4-d7
	bsr .next_line
.lb11:
	dbf d5,.lb12
	bra .lb14
.lb15:
	moveq #8,d0
	btst #1,d6
	beq.s .lb16
	moveq #13,d0
.lb16:
	move.l (a6),a0				; chaine validation
	move.l 4(a6),a1			; chaŒne masque
	move.l d0,-(a6)			; flag
	clr.l -(a6)					; state
	move.l #$00000200,-(a6)	; x=0+2 pixels
	move.l d7,-(a6)			; position
	move.l d4,-(a6)			; l
	moveq #1,d0
	move.l d0,-(a6)			; h
	move.l a3,-(a6)			; la chaŒne
	move.l a1,-(a6)			; le masque
	move.l a0,-(a6)			; la validation
	moveq #2,d0
	move.l d0,-(a6)			; just centre
	move.l #$00001180,-(a6)	; couleur
	moveq.l #29,d1				; FTEXT
	movem.l a3/d4-d7,-(sp)
	moveq #0,d7
	bsr _boxtext
	movem.l (sp)+,a3/d4-d7
	bsr.s	.next_line
.lb10:
	dbf d5,.lb15
.lb14:
	bsr parent					; ferme la s‚rie des enfants du z‚ro
	bsr lastobj					; marque le dernier objet
	btst #2,d6					; des ‚ditables?
	beq.s .lb17
	addq.l #8,a6				; si oui, d‚pile masque et validation
.lb17:
	rts							; l'adresse retour est d‚j… sur la pile
.box:
	move.l d7,-(a6)			; flag
	clr.l -(a6)					; state
	move.l d0,-(a6)			; spec
	move.l d4,d0
	add #$0400,d0				; +4 pixels de d‚calage
	move.l d0,-(a6)			; x=l+4
	move.l d2,d0
	add #$0200,d0				; + 2 pixels par rapport … la bordure
	move.l d0,-(a6)			; y
	moveq #1,d7
	btst #31,d6
	beq.s .b1
	moveq #2,d7					; fonte rectangulaire, boutons plus larges
.b1:
	move.l d7,-(a6)			; w
	move.l d3,-(a6)			; h
	moveq #0,d7
	movem.l a3/d4-d6,-(sp)
	bsr xylh						; cr‚e l'objet
	movem.l (sp)+,a3/d4-d6
	rts
.next_line:
	addq.l #1,d7
	moveq #0,d0
	move -2(a3),d0				; taille chaine
	addq.l #4,d0				; 0 + even + taille
	bclr #0,d0					; pair
	add.l d0,a3					; chaine suivante
	rts

	SAUT
assign_array:
	move.l (a6)+,a0			; adresse arbre GEM_LIST
	move.l (a6)+,a1			; 1er ‚l‚ment tableau
	moveq #0,d1
	move -2(a1),d1				; taille chaŒne
	addq.l #4,d1
	bclr #0,d1					; offset d'une chaŒne … l'autre
.lb0:
	cmp #28,6(a0)				; type string?
	bne.s .lb1
	move.l a1,12(a0)			; string: remplace la chaŒne
	bra.s .lb2
.lb1:
	cmp #29,6(a0)				; un ftext?
	bne.s .lb3
	move.l 12(a0),a2			; le TED
	move.l a1,(a2)				; change la chaine
.lb2:
	add.l d1,a1					; chaine suivant
.lb3:
	btst #5,9(a0)				; lastobj ?
	bne.s .lb4					; oui on quitte
	lea 24(a0),a0				; objet suivant
	bra.s .lb0
.lb4:
	rts

	COPIE highw,y227
highw:
	move.l (a6)+,d1
	clr d1
	swap d1
	move.l d1,-(a6)
y227: rts

	COPIE loww,y224
loww:
	clr (a6)
y224: rts

	COPIE lowb,y225
lowb:
	and.l #$000000FF,(a6)
y225: rts

	COPIE highb,y226
highb:
	move.l (a6)+,d1
	and.l #$0000FF00,d1
	lsr.w #8,d1
	move.l d1,-(a6)
y226: rts

	SAUT
gem_input:
	lea .ted(pc),a0
	move.l (a6)+,(a0)+	; adresse chaine r‚ponse
	move.l (a6)+,a3		; adresse prompt
	move.b #'X',d0			; valide tout caractŠre par d‚faut
	cmp.b #'|',1(a3)		; validation sp‚cifi‚e?
	bne.s .lb0				; non, on garde X
	move.b (a3),d0			; si oui, on prend
	addq.l #2,a3			; et on saute au prompt
.lb0:
	move.l a3,(a0)+		; chaine prompt
	move.l topprg,a1		; chaine valid temporaire
	move.l a1,(a0)+		; qu'on range
	moveq #0,d7				; taille chaine
	moveq #1,d6				; taille champ (compte le z‚ro final)
.lire_prompt:
	move.b (a3)+,d1
	beq.s .lb1				; fin de chaine
	addq #1,d7
	cmp.b #'_',d1
	bne.s .lire_prompt
	move.b d0,(a1)+		; ajouter … valid
	addq #1,d6
	bra.s .lire_prompt
.lb1:
	clr.b (a1)				; termine valid
	lea 12(a0),a0
	move d6,(a0)+			; taille champ
	move d7,(a0)+			; taille prompt, tedinfo complŠte
	lea .arbre+16(pc),a0
	clr.l (a0)+				; BOX : x,y =0
	move d7,d0
	addq #2,d0				; largeur = ftex+2 caractŠres
	cmp #10,d0
	bpl.s .lb2
	moveq #10,d0			; largeur minimale 10 pour bouton ok
.lb2:
	move d0,(a0)+
	move #5,(a0)+			; hauteur 5
	lea 16(a0),a0
	move.l #$10001,(a0)+	; FTEXT x,y = 1,1
	move d7,(a0)+
	move #1,(a0)+
	bclr #0,11(a0)			; vire bit SELECTED d'un pr‚c‚dent appel
	lea 16(a0),a0			; BUTTON
	subq #8,d0
	lsr #1,d0
	move d0,(a0)+			; x centr‚
	move #3,(a0)+			; y
	move.l #$80001,(a0)+	; l,h
	moveq #2,d7
	lea .arbre(pc),a3
.obfix:
	move.l d7,-(a6)		; objet
	move.l a3,-(a6)	; arbre
	bsr rsrc_obfix
	dbf d7,.obfix
	move.l a3,-(a6)
	bsr form_center		; centre l'arbre
	moveq #0,d0
	bsr.s .fdial
	clr.l -(a6)				; commencer par objet 0
	moveq #1,d0
	move.l d0,-(a6)		; profondeur 1 niveau
	move.l #intout+2,-(a6)
	bsr get_xywh			; les 4 coordonn‚es
	move.l a3,-(a6)		; l'arbre
	bsr objc_draw			; on dessine !
	moveq #1,d0
	move.l d0,-(a6)		; champ ‚ditable 1
	move.l a3,-(a6)
	bsr form_do
	moveq #3,d0
	bsr.s .fdial
	rts
.fdial:
	move.l d0,-(a6)		; flag 0 ou 3
	clr.l -(a6)
	clr.l -(a6)
	clr.l -(a6)
	clr.l -(a6)				; x,y,l,h ind‚finis
	lea intout+2,a0
	bsr get_xywh+2			; X,Y,L,H
	bsr form_dial
	rts
.arbre:
	dc.w -1,1,2,20,0,16,2,$1100,0,0,0,5	; box
	dc.w 2,-1,-1,29,8,0
	dc.l .ted
	dc.w 1,1,0,1	; ftext
	dc.w 0,-1,-1,26,$27,0
	dc.l .ok
	dc.w 0,3,8,1	; bouton ok
.ted:
	dc.l 0,0,0		; chaines
	dc.w 3,6,2,$1180,0,-1,0,0
.ok: dc.b "Ok",0,0

	SAUT
unpackdate:
	move.l (a6)+,a0
	bsr twochar
	move.l d0,-(a6)
	bsr twochar
	move.l d0,-(a6)
	bsr twochar
	move.l d0,-(a6)
	rts

	SAUT
packdate:
	movem.l (a6)+,d1-d3
	lea pad+2,a0
	move.l a0,-(a6)
	move.l d3,d0
	bsr twodigits
	move.b #'/',(a0)+
	move.l d2,d0
	bsr twodigits
	move.b #'/',(a0)+
	moveq #0,d0
	divs #100,d1
	move d1,d0
	beq.s .lb0		; ann‚e sur 2 chiffres
	bsr twodigits
.lb0:
	clr d1
	swap d1
	move.l d1,d0
	bsr twodigits
	clr.b (a0)
	rts


	SAUT
resize_list:
	move.l (a6)+,a0		; adresse arbre
	move.l (a6)+,d1		; nombre de lignes souhait‚es
	moveq #0,d0
	move.b -1(a0),d0		; nombre maxi de lignes
	cmp.l d0,d1
	bgt.s .bug				; trop grand
	move.b -2(a0),d6		; les flags
	moveq #1,d0				; nombre minimal de lignes
	btst #1,d6				; des flŠches?
	beq.s .lb0
	moveq #2,d0				; si flŠches, minimal 2 lignes
.lb0:
	cmp.l d0,d1
	bge.s .ok				; ca passe
.bug:
	clr.l -(a6)				; erreur, renvoie 0
	rts
.ok:
	move.l a0,a1			; conserve objet 0
	move.w 24+22(a0),d5	; hauteur objet 1, donc d'une ligne
	move d1,d0
	muls d5,d0				; h*n hauteur cadre
	addq.l #4,d0			; plus 4 pixels (2 haut 2 bas)
	move d0,22(a0)			; stock‚e
	btst #0,d6				; des flŠches?
	moveq #1,d2				; premiŠre ligne de texte par d‚faut
	beq.s .lb1				; non, on saute
	sub d5,d0				; h*(n-1) position flŠche du bas
	subq #2,d0				; moins 2 pixels
	move d0,24*2+18(a0)	; stock‚ dans y de l'objet 2
	sub d5,d0				; h*(n-2) hauteur cadre entre les flŠches
	subq #2,d0				; moins 2 pixels
	move d0,24*3+22(a0)	; stock‚ dans h de l'objet 3
	moveq #4,d2				; premiŠre ligne de texte
.lb1:
	move d2,d0
	muls #24,d0				; offset vers 1ere ligne
	add.l d0,a0				; pointe sur l'objet
	subq #1,d1
	bra.s .lb3
.lb2:
	addq #1,d2				; pointe vers objet suivant
	move d2,(a0)			; ob_next
	bclr #5,9(a0)			; efface lastobj
	lea 24(a0),a0			; suivant
.lb3:
	dbf d1,.lb2
	clr (a0)					; dernier objet repointe sur le pŠre 0
	bset #5,9(a0)			; et met lastobj
	move d2,4(a1)			; dernier objet come ob_tail du cadre 0
	moveq #1,d0
	move.l d0,-(a6)		; tout bon, renvoie 1
	rts


	COPIE language,y228,1
language:
	move.l #langage,-(a6)
y228:
	rts

	SAUT
changeext:
	move.l (a6)+,a0		; adresse chaine
	lea pad+2,a1			; destination
	move.l a1,a2			; critŠre d'arret au retour
	move.l (a6)+,a3		; la nouvelle extension
	move.l a1,-(a6)		; chaine renvoy‚e = pad
	moveq #'.',d1
.copy:
	move.b (a0)+,(a1)+
	bne.s .copy
	subq.l #1,a1			; revient sur le z‚ro
	move.l a1,a0			; point par d‚faut
.cherche:
	cmp.l a1,a2				; retour au d‚but?
	beq.s .found			; oui, a0 est donc valide
	move.b -(a1),d0
	cmp.b d1,d0				; un point ?
	beq.s .new				; debut d'extention trouv‚e
	cmp.b #':',d0
	beq.s .found			; idem, d‚but de chemin, a0 valide
	cmp.b #'\',d0
	beq.s .found			; idem
	bra.s .cherche
.new:
	move.l a1,a0
.found:
	move.b d1,(a0)+		; copie le point
	cmp.b (a3),d1			; y en a t'il un aussi dans l'extension?
	bne.s .copyext
	addq.l #1,a3			; si oui on le saute
.copyext:
	move.b (a3)+,(a0)+
	bne.s .copyext
	rts

	; cherche la pr‚sence de ARGV= dans la chaine d'environnement
	; si trouv‚, remplit le tableau de pointeurs _argv avec les arguments
	; si pas trouv‚, s‚pare la chaine de commande en arguments avec espace comme s‚parateur
	; et remplit _argv
	; dans tous les cas, renvoie le nombre d'arguments dans _argc
	; _argc=0 si seul le nom du programme est fourni

	; en cas d'accessoire, argc=0 et nom=""

	; en cas de PRG AUTO, ou TOS/TTP pas de nom

	; sinon, shel_read renvoie le nom si ce n'est pas le protocole ARGV=

init_argv:
	lea _argv,a1			; tableau des pointeurs de chaine
	moveq #-1,d0			; nombre d'arguments
	tst.l _app_flag		; est-ce un ACC ?
	beq.s .normal			; oui, renvoie un minimum
	move.l bspage,a0
;	cmp.b #127,128(a0)	; taille command line = 127?
;	bne.s .normal			; non, pas de ARGV
	move.l $2c(a0),a0		; chaine d'environnement
.autre:
	tst.b (a0)				; fin des chaines?
	beq.s .normal			; oui, donc pas de ARGV
	cmp.b #'A',(a0)+
	beq.s .teste
.avance:
	tst.b (a0)+
	bne.s .avance			; va … la fin de la ligne
	bra.s .autre
.teste:
	cmp.b #'R',(a0)
	bne.s .avance
	addq.l #1,a0
	cmp.b #'G',(a0)
	bne.s .avance
	addq.l #1,a0
	cmp.b #'V',(a0)
	bne.s .avance
	addq.l #1,a0
	cmp.b #'=',(a0)
	bne.s .avance
	clr.b -4(a0)			; met fin … l'environnement sur "ARGV="
.avance2:
	tst.b (a0)+
	bne.s .avance2
	tst.b (a0)				; fin des chaines?
	beq.s .fini
	move.l a0,(a1)+		; un pointeur de plus
	addq.l #1,d0
	cmp #63,d0
	bmi.s .avance2
.fini:
	move.l d0,_argc
	rts
.normal:
	move.l bspage,a0
	addq.l #1,d0			; valide argv(0)
	move.l #_argc,(a1)+	; qui pointera sur une chaine nulle (octet fort du nombre)
	tst.l _app_flag		; est-ce un ACC
	beq.s .fini				; oui on quitte
	lea 128(a0),a0
	tst.b (a0)+				; taille chaine?
	beq.s .exit				; nulle, pas d'argument
.encore:
	move.l a0,(a1)+		; un argument
	addq.l #1,d0
	cmp #63,d0
	beq.s .exit
.cherche:
	move.b (a0)+,d1		; un caractŠre
	beq.s .exit				; fin de chaine
	cmp.b #' ',d1			; un espace?
	bne.s .cherche
	clr.b -1(a0)			; fin de chaine si espace
.avance3:
	move.b (a0)+,d1
	beq.s .exit
	cmp.b #' ',d1
	beq.s .avance3			; saute tous les espaces
	subq.l #1,a0			; si autre, revient dessus
	bra.s .encore
.exit:
	ifd LIB					; sous l'interpr‚teur, toujours AES pr‚sent
		tst.b aes_flag			; est-ce un PRG dans le dossier AUTO?
		beq.s .fini				; oui !
		tst screen_percent	; est-ce un programme TOS/TTP ?
		beq.s .fini
	endif
	move.l d0,_argc
	move.l pilptr,a6
	lea setdat,a0			; utilise la zone de pads
	move.l a0,_argv		; pads contiendra le chemin d'accŠs au programme = ARGV[ 0 ]
	move.l a0,-(a6)		; pour retour nom programme
	move.l topprg,-(a6)	; pour retour chaine commande (inutile)
	jsr shel_read
	rts




	SAUT
argv:
	move.l (a6)+,d0		; index de la chaine voulue
	bpl.s .ok1
	moveq #0,d0				; valeur mini, 0
.ok1:
	lea _argv,a0
	move.l _argc,d1
	cmp.l d1,d0
	ble.s .ok
	move.l d1,d0			; valeur maxi _argc
.ok:
	lsl.l #2,d0
	move.l 0(a0,d0.l),-(a6)	; renvoie la chaine voulue
	rts

	SAUT
argc:
	move.l _argc,-(a6)
	rts

	SAUT
pterm:
	move.l (a6)+,d0
	move d0,ret_val
	jmp fin

	SAUT
ptermres:
	move.l (a6)+,d0
	lea ret_val,a0
	move d0,(a0)+
	move.l (a6)+,(a0)		; et taille … conserver
	jmp fin

	SAUT
isqr:
	move.l (a6),d1
	bne.s .p0
	rts
.p0:
	cmp.l #65536,d1
	bcc.s .grand
	cmp #256,d1
	bcc.s .p1
	cmp #16,d1
	bcc.s .p2
	cmp #4,d1
	bcc.s .p3
	moveq #2,d0
	bra .newt
.p3:
	moveq #3,d0
	bra .newt
.p2:
	cmp #64,d1
	bcc.s .p4
	moveq #6,d0
	bra .newt
.p4:
	moveq #12,d0
	bra .newt
.p1:
	cmp #4096,d1
	bcc.s .p5
	cmp #1024,d1
	bcc.s .p6
	moveq #24,d0
	bra .newt
.p6:
	moveq #48,d0
	bra .newt
.p5:
 	cmp #16384,d1
 	bcc.s .p7
 	moveq #96,d0
 	bra .newt
.p7:
	move #192,d0
.newt:
	move.l d1,d2
	divu d0,d2
	ext.l d2
	add.l d2,d0
	lsr.l #1,d0
	bcc.s .new1
	addq.l #1,d0
.new1:
	; ******** plus de pr‚cision *******
	move.l d1,d2
	divu d0,d2
	ext.l d2
	add.l d2,d0
	lsr.l #1,d0
	bcc.s .new2
	addq.l #1,d0
.new2:
	move.l d0,(a6)
	; *********
	rts
.grand:
	swap d1
	moveq #0,d0
	cmp #256,d1
	bcc.s .g1
	cmp #16,d1
	bcc.s .g2
	cmp #4,d1
	bcc.s .g3
	move #384,d0
	bra .gnew
.g3:
	move #768,d0
	bra .gnew
.g2:
	cmp #64,d1
	bcc.s .g4
	move #1536,d0
	bra .gnew
.g4:
	move #3072,d0
	bra .gnew
.g1:
	cmp #4096,d1
	bcc.s .g5
	cmp #1024,d1
	bcc.s .g6
	move #6144,d0
	bra .gnew
.g6:
	move #12288,d0
	bra .gnew
.g5:
 	cmp #16384,d1
 	bcc.s .g7
 	move #24376,d0
 	bra.s .gnew
.g7:
	move #48752,d0
.gnew:
	swap d1
	move.l d1,d2
	divu d0,d2
	swap d2
	clr d2
	swap d2
	add.l d2,d0
	lsr.l #1,d0
	bcc.s .new3
	addq.l #1,d0
.new3:
	; ********* plus de pr‚cision *******
	move.l d1,d2
	divu d0,d2
	swap d2
	clr d2
	swap d2
	add.l d2,d0
	lsr.l #1,d0
	bcc.s .new4
	addq.l #1,d0
.new4:
	; ***********
	move.l d0,(a6)
	rts

	COPIE illeg,y229
illeg:
	illegal
y229:
	rts

	SAUT
irandom:
	lea random_data(pc),a0
	move.l (a0)+,d0
	move.l 0(a0,d0.w),d1		; premiŠre valeur
	subq #4,d0
	bpl.s .lb0
	move #64,d0
.lb0:
	swap d0
	add.l 0(a0,d0.w),d1			; ajout‚
	move.l d1,0(a0,d0.w)			; et on remplace
	subq #4,d0
	bpl.s .lb1
	move #64,d0
.lb1:
	swap d0
	move.l d0,-(a0)				; pointeurs … jour
	lsr.l #8,d1						; sur 24 bits
	move.l d1,-(a6)
	rts

random_data:
	dc.w 64,36		; pointeurs originaux
	dc.l 128843799,1507331,228023,2058816158
	dc.l 178126855,459418,43664857,1171849264
	dc.l 3145785,3763582,1836975071,64946184
	dc.l 531700,485752901,4522868,57945181
	dc.l 744294318
	; en double pour randomize
	dc.w 64,36		; pointeurs originaux
	dc.l 128843799,1507331,228023,2058816158
	dc.l 178126855,459418,43664857,1171849264
	dc.l 3145785,3763582,1836975071,64946184
	dc.l 531700,485752901,4522868,57945181
	dc.l 744294318

	SAUT
irandomize:
	lea random_data(pc),a0
	lea 18*4(a0),a1
	move.l (a6)+,d0		; valeur xor
	move.l (a1)+,(a0)+	; les pointeurs
	moveq #16,d1
.lb1:
	move.l (a1)+,d2
	eor.l d0,d2
	rol.l #5,d0				; d‚cale le xor
	move.l d2,(a0)+
	dbf d1,.lb1
	rts

_aligne:
	dc.b 0,4				; quadrant 0-90 align‚ gauche bas
	dc.b 2,4				; quadrant 90-180 align‚ droite bas
	dc.b 2,5				; quadrant 180,270 align‚ haut droite
	dc.b 0,5				; quadrant 270-360 align‚ haut gauche
	dc.b 0,4				; en cas de 360...
	; ici on a sur la pile a0,a1,r,x,y
add_pie_label:
	movem.l d0-d7/a2-a6,-(sp)
	move.l (a6),d5
	add.l 4(a6),d5
	divs #20,d5			; moyenne des angles en degr‚s
	and.l #$0000FFFF,d5	; garde le quotient
	move.l d5,-(a6)
	divs #90,d5			; divise en quadrant (0,1,2,3,4 si pile 360... mais normalement pas possible)
	add d5,d5
	lea _aligne(pc,d5.w),a0
	moveq #0,d0
	move.b (a0)+,d0
	move.l d0,-(a6)	; alignement horizontal
	move.b (a0)+,d0
	move.l d0,-(a6)	; alignement vertical
	bsr vst_alignment
	GOSUB intfl			; en degr‚ r‚el
	bsr torad			; en radian r‚el
	GOSUB sincos			; calcule sin et cos
	move.l 24(a6),d0	; le rayon
	addq.l #4,d0		; r+4
	move.l d0,-(a6)
	GOSUB intfl
	GOSUB ffois			; (r+4)cos
	GOSUB flint
	move.l (a6)+,d0
	add.l 24(a6),d0	; x+(r+4)cos = X texte
	move.l d0,-(sp)	; on conserve
	move.l 16(a6),d0	; r
	addq.l #4,d0		; r+4
	move.l d0,-(a6)
	GOSUB intfl
	GOSUB ffois
	GOSUB flint
	move.l (a6)+,d1
	btst #5,28(sp)		; bit #29 de D6
	beq.s .no_double
	add.l d1,d1			; TT Basse, corriger !
.no_double:
	btst #4,28(sp)
	beq.s .no_mid
	asr.l #1,d1			; ST Moyenne, corriger !
.no_mid:
	move.l 12(a6),d0	; y
	sub.l d1,d0		; y-(r+4)sin = Y texte
	move.l (sp)+,-(a6)	; X
	move.l d0,-(a6)		; Y
	lea gr3_angle+8,a3
	bsr get_one_string
	bne.s .affiche
	addq.l #8,a6			; d‚pile
	bra.s .fin
.affiche:
	move.l a3,-(a6)		; chaine
	bsr v_gtext				; affiche le texte en X,Y
.fin:
	movem.l (sp)+,d0-d7/a2-a6
	rts
	
	




	; x y r addr n t " xxx" c h gr_pie_label
	; pareil que pie mais avec une chaine de labels de c caractŠres chacun
	; et de taille "h" (0=font 6, 1=fonte 8, 2= fonte 16, 3=fonte 32, autre inchang‚
	
	SAUT
gr_hpie_label:
	move.l #$409c2000,d4			; pour une valeur 1800 (demi-tour)
	bra.s _gr_pie_label_comm

	SAUT
gr_pie_label:
	move.l #$40ac2000,d4			; pour une valeur 3600 (tour complet)
_gr_pie_label_comm:
	bsr sauve_text
	moveq #16,d0
	bset #31,d0						; garder mode relatif et ne pas faire _calc_coeffs
	bsr set_label_common			; ‚criture horizontale, mode replace
	moveq #0,d6
	XBIOS 4,2						; getrez
	cmp #7,d0
	bne.s .pas_tt_basse
	bset #29,d6						; pour doubler dy des labels
.pas_tt_basse:
	cmp #1,d0
	bne.s .pas_st_moyenne
	bset #28,d6						; pour diviser dy des labels
.pas_st_moyenne:
	move.l (a6)+,d1				; taille caractŠres
	lea gr3_angle,a0
	st (a0)
	addq.l #2,a0
	move.l (a6)+,d0
	move.w d0,(a0)+				; nombre de caractŠres par label
	move.l (a6)+,(a0)+			; adresse de la chaŒne
	tst.l d1
	bmi.s _all_pies				; si n‚gatif, on saute
	moveq #4,d0
	cmp.l d0,d1
	bpl.s _all_pies				; si >3 on saute
	move.b .tailles(pc,d1.l),d1	; sinon convertit en hauteur caractŠres
	move.l d1,-(a6)
	bsr vst_height					; fixe la taille !
	bra.s _all_pies	
.tailles:
	dc.b 4,6,13,26

	; x y r addr n t gr_pie
	; x,y,r pour le disque
	; n valeurs en addr (taille selon size)
	; t=type 1,2,3,4
	; 4=1 … 8 remplissages
	; 2=9 … 24 motifs
	; 3=1 … 12 hachures
	; 1=couleurs de 2 … 15

	SAUT
gr_hpie:
	move.l #$409c2000,d4			; pour une valeur 1800 (demi-tour)
	bra.s _gr_pie_comm

	SAUT
gr_pie:
	move.l #$40ac2000,d4			; pour une valeur 3600 (tour complet)
_gr_pie_comm:
	sf gr3_angle
	moveq #0,d6
_all_pies:
	movem.l d4/a4-a5,-(sp)
	bsr gr_init
	ble .out					; si d7<=0 pas de graphique
	bsr calc_coeff			; somme des donn‚es et calcul du coefficient data->angle
	addq.l #4,sp			; vire le d4 du d‚but, inutile
	move.l d6,-(sp)		; on conserve
	moveq #0,d4				; angle de d‚part
	move.l d4,-(sp)		; conserve
	moveq #100,d5			; valeur qui d‚passe tout
	move.l d5,-(sp)
	move.l d7,-(sp)		; pour la boucle
	movem.l d0-d1,-(sp)	; sauve coeff
	move.l d4,-(sp)
	move.l d4,-(sp)		; angle en r‚el
.boucle:
	move.l 28(sp),d6
	move.l 24(sp),d4		; angle … envoyer (si mode user)
	move.l 20(sp),d5
	addq.l #1,d5			; pour le suivant
	bsr next_fill			; fixe le motif/couleur suivant
	move.l d5,20(sp)
	lea 12(a6),a0
	move.l -(a0),-(a6)	; recopie x
	move.l -(a0),-(a6)	; y
	move.l -(a0),-(a6)	; r
	move.l 24(sp),-(a6)	; angle courant
	cmp #3,sizeptr
	beq.s .float
	jsr (a4)					; ramŠne une donn‚e
	move.l d0,-(a6)
	GOSUB intfl
	movem.l (a6)+,d2-d3	; la donn‚e en r‚el
	bra.s .bb1
.float:
	movem.l (a3)+,d2-d3
.bb1:
	movem.l 8(sp),d0-d1
	GOSUB submul
	movem.l (sp),d2-d3
	GOSUB subplus
	movem.l d0-d1,(sp)
	movem.l d0-d1,-(a6)
	GOSUB flint
	move.l (a6),24(sp)		; nouvel angle
	tst.b gr3_angle			; doit-on ajouter les labels?
	beq.s .no_label
	move.l 28(sp),d6			; pour les flags double/moiti‚ dy
	bsr add_pie_label
.no_label:
	bsr v_pieslice
	subq.l #1,16(sp)
	bne .boucle
	lea 32(sp),sp			; vire angle, coeff et d7,d5,d4,d6
.out:
	movem.l (sp)+,a4-a5
	lea 12(a6),a6			; vire x,y,r
	bsr restaure_fill
	tst.b gr3_angle
	beq.s .pas_texte		; si pas de labels, pas de texte … restaurer.
	bsr restaure_text
.pas_texte:
	rts

calc_coeff:
	move.l a3,a2			; sauve le pointeur
	move.l d6,-(sp)
	move.l d7,-(sp)		; sauve
	cmp #3,sizeptr
	beq.s .float1
	moveq #0,d2
	move d7,d1
	bra.s .cc1
.cc2:
	jsr (a4)					; une donn‚e
	add.l d0,d2
.cc1:
	dbf d1,.cc2
	move.l d2,-(a6)
	GOSUB intfl
	movem.l (a6)+,d2-d3
	bra.s .cc4
.float1:
	moveq #0,d0				; somme
	moveq #0,d1
	move.l d7,-(sp)
.cc3:
	movem.l (a3)+,d2-d3
	GOSUB subplus
	subq.l #1,(sp)
	bne.s .cc3
	addq.l #4,sp
	move.l d1,d3
	move.l d0,d2
.cc4:
	; sur la pile d7/d6/bsr/d4
	move.l 12(sp),d0		; valeur pour 3600 ou 1800
	moveq #0,d1				; d0-d1 = float 3600/1800
	GOSUB subdiv				; d0-d1 = coeff !!! (3600/somme) pour des 1/10 de degr‚s
	move.l a2,a3			; retour du pointeur
	move.l (sp)+,d7		; et du nombre
	move.l (sp)+,d6
	rts


	; t<=0 revient … t=0
	; pour 1,2,3,4 c'est ok
	; au dessus de 4, on considŠre que c'est un mot user
	;    mais <diko, on annule = t=0
	;    et si ce n'est pas un mot assembl‚, idem
	;	  sinon d6=FFFF et a5=adresse routine fill
	;
	; en sortie, d6 corrig‚ et a5 pointe sur le bloc d'indices fill

set_fill:
	lea fill_limit(pc),a5
	moveq #5,d0				; block "ne rien faire"
	tst d6
	ble.s .lb1				; si d6<=0, ne rien faire
	cmp #4,d6				; 1 … 4, c'est ok
	ble.s .ok
	cmp #diko,d6
	blt.s .lb1				; si c'est un mot avant les mots user, on revient … t=0
	if STE=0
   	lea (adresse,d6.w*4),a0
   else
   	lea adresse,a0
   	asl #2,d6
   	add d6,a0
   endif
   move.l (a0),a0			; adresse routine
   cmp #437,(a0)+			; est-ce un mot assembl‚?
   bne.s .lb1				; non donc on revient … t=0
   move #$FFFF,d6			; marqueur "user fill"
   move.l a0,a5			; adresse de la routine "fill"
   rts
.ok:
	moveq #1,d0
	move.l d0,-(a6)
	bsr vsf_perimeter		; active le contour
	move.l d6,d0			; type de remplissage
	cmp #4,d6
	bne.s .lb0
	moveq #2,d0
.lb0:
	move.l d0,-(a6)
	bsr vsf_interior
	move.l d6,d0
	cmp #1,d0				; utiliser la couleur?
	bne.s .lb11				; non...
	move code_ecran,d1
	bclr #15,d1
	moveq #-1,d0			; mono...
	cmp #1,d1
	beq.s .lb11
	moveq #0,d0
	cmp #2,d1				; mode 4 couleurs?
	beq.s .lb11
	moveq #1,d0				; sinon, 16 couleurs ou plus
	bra.s .lb11
.lb1:
	moveq #0,d6				; en cas de d‚passement, on revient … t=0
.lb11:
	muls #3,d0
	lea -3(a5,d0.l),a5	; pointeur sur le bloc flag,min,max
	rts



next_fill:
	tst d6
	bpl.s .auto				; si positif, g‚r‚ automatiquement par FORTH
	move.l d4,-(a6)		; envoie le num‚ro de colonne (1-n) … ma routine
	move.l d5,-(a6)		; envoie l'index d5 (>=100 reset, sinon … modifier par la routine)
	movem.l a2-a5/d4-d7,-(sp)
	move.l _sauve_a4(pc),a4
	jsr (a5)					; appelle le mot user pour fixer le remplissage
	movem.l (sp)+,a2-a5/d4-d7
	move.l (a6)+,d5
	rts
.auto:
	tst.b (a5)				; premier octet -1?
	bpl.s .ok
	rts						; si -1 ne rien faire
.ok:
	cmp.b 2(a5),d5			; a-t-on d‚pass‚ le max?
	bls.s .lb0				; non
	move.b 1(a5),d5		; sinon retour au min
.lb0:
	tst.b (a5)
	beq.s .lb1				; si 0, vsf_color
	move.l d5,-(a6)
	bsr vsf_style			; sinon, style !
	rts
.lb1:
	tst d5					; couleur = 0 ?
	bne.s .lb2
	move.l d5,-(a6)		; si oui, on revient au remplissage de fond
	bsr vsf_interior
	moveq #1,d0
	move.l d0,-(a6)		; et couleur noire pour le contour
	bsr vsf_color
	rts
.lb2:
	cmp #1,d5				; couleur noire?
	bne.s .lb3
	move.l d5,-(a6)		; si oui, c'est qu'on revient du blanc
	bsr vsf_interior		; donc retour aux couleurs
.lb3:
	move.l d5,-(a6)
	bsr vsf_color
	rts

	; ici flag,min,max
	; flag=0 vsf_color, =1 vsf_style
	; min,maxplage des valeurs pour d5

	dc.b 0,0,1				; couleurs en monochrome
	dc.b 0,0,3				; en 4 couleurs
fill_limit:
	dc.b 0,2,15				; en 16 couleurs on ‚vite noir et blanc
	dc.b 1,9,24				; motifs
	dc.b 1,1,12				; hachures
	dc.b 1,1,8				; remplissage
	dc.b -1,-1				; type z‚ro, ne rien faire
sauve_text: 
	bsr vqt_attributes
	lea intout+4,a0
	lea sauve_text_data(pc),a1
	move.l ptsout,(a1)+	; larg/haut caractŠre
	move.l (a0)+,(a1)+	; angle / hpos
	move.l (a0)+,(a1)+	; vpos / mode
	rts
sauve_fill:
	bsr vqf_attributes
	lea intout,a0
	lea sauve_fill_data(pc),a1
	move.l (a0)+,(a1)+	; vsf_interior + couleur
	move (a0)+,(a1)+		; index motif
	move 2(a0),(a1)+		; vsf_perimeter
	move (a0)+,(a1)+		; writing mode
	rts
sauve_fill_data: dc.l 0,0,0
restaure_fill:
	lea sauve_fill_data(pc),a3
	move (a3)+,-(a6)
	clr -(a6)
	bsr vsf_interior
	move (a3)+,-(a6)
	clr -(a6)
	bsr vsf_color
	move (a3)+,-(a6)
	clr -(a6)
	bsr vsf_style
	move (a3)+,-(a6)
	clr -(a6)
	bsr vsf_perimeter
	rts
sauve_text_data: dc.l 0,0,0
restaure_text:
	lea sauve_text_data+2(pc),a3
	move (a3)+,-(a6)
	clr -(a6)
	bsr vst_height
	move (a3)+,-(a6)
	clr -(a6)
	bsr vst_rotation
	move (a3)+,-(a6)
	clr -(a6)	
	move (a3)+,-(a6)
	clr -(a6)
	bsr vst_alignment
	move (a3)+,-(a6)
	clr -(a6)
	bsr vswr_mode
	rts

get_adr:
	dc.l get_byte,get_word,get_long,get_float

get_byte:
	moveq #0,d0
	move.b (a3)+,d0
	rts
get_word:
	moveq #0,d0
	move (a3)+,d0
	rts
get_long:
	move.l (a3)+,d0
	rts
get_float:
	movem.l (a3)+,d2-d3
	rts

gr_init:
	bsr sauve_fill
	or.l (a6)+,d6			; pour conserver les bit 31/30
								; type de remplissage voulu
	bsr set_fill
	move.l (a6)+,d7		; nombre de donn‚es
	bclr #30,d6				; barres simples ou empil‚es?
	bne.s .lb0
	move.l (a6)+,a3		; ici, barres simples, leur adresse
	bra.s .commun
.lb0:
	lea gr3_angle+84,a2
	cmp #1,d6				; type = 1 ? (couleurs)
	seq -84(a2)				; FF si d‚calage 1 pixel pour barres couleur
	move.l a2,a3
	clr.l -(a3)				; fin de liste
	move.l (a6)+,d0		; nombre de barres … empiler
	bne.s .lb2				; tout va
	rts						; sinon, renvoie EQ, sortie de la routine
.lb1:
	move.l (a6)+,-(a3)
.lb2:
	dbf d0,.lb1
	move.l a3,(a2)			; liste organis‚e: (adr)-> a1,a2..,ak,0,adr
	move.l a3,a2			; a2 pointe sur le d‚but de liste des adresses
.commun:
	move sizeptr,d0
	lsl #2,d0
	lea get_adr(pc),a4
	move.l 0(a4,d0.w),a4	; adresse pour prendre une donn‚e
	tst.l d7
.fin:
	rts

	; dy addr n t gr_barg
	; comme gr_bar sauf paramŠtre dy:
	; c'est le pas de trac‚ de la grille sur l'axe vertical:
	;  si dy<0, mettre la grille sous le graphique
	;  si dy>0, mettre la grille sur le graphique

	SAUT
gr_barg:
	moveq #0,d6
	bset #31,d6		; marqueur grille
						; barres simples, bit 30=0
	bra.s _gr_bar_comm

	; addr n t gr_bar
	; c'est la fenˆtre en cours qui sert de rectangle
	; n valeurs en addr (taille selon size)
	; t=type 1,2,3,4
	; 4=1 … 8 remplissages
	; 2=9 … 24 motifs
	; 3=1 … 12 hachures
	; 1=couleurs de 2 … 15
	; 0=ne pas changer les r‚glages de remplissage


	SAUT
gr_bar:
	moveq #0,d6		; pas de grille, bit31 = 0
						; barres simples, bit30 = 0
_gr_bar_comm:
	movem.l a4-a5,-(sp)
	move.l a4,_sauve_a4
	move.b xy_flag,xy_flag+1
	sf xy_flag				; mode absolu
	bsr.s gr_init
	ble .out			; si d7<=0 pas de graphique (d7= nombre de donn‚es)
	movem.l d6-d7,-(sp)
	bsr calc_minmax
	move.l a4,-(sp)
	move.l _sauve_a4(pc),a4
	bsr _calc_coeffs
	move.l a4,_sauve_a4
	move.l (sp)+,a4
	movem.l (sp)+,d6-d7
	tst.l d6				; grille?
	bpl.s .no_grid
	bclr #7,(a6)		; valeur absolue de dy
	beq.s .no_grid		; dy>0 donc par dessus le graphique
	bsr _add_grid		; car la grille se sert de A4 comme pointeur de pile
.no_grid:
	movem.l d6-d7,-(sp)
	moveq #0,d0
	move.l d0,-(a6)
	move.l d0,-(a6)	; float x=0
	move.l d0,-(a6)
	move.l d0,-(a6)	; float y=0
	bsr _xy_bar				; vers coordonn‚es ‚cran sur la pile
	moveq #1,d4			; compteur
	moveq #100,d5
	movem.l (sp)+,d6-d7
.encore:
	addq.l #1,d5
	bsr next_fill
	movem.l d4-d7,-(sp)
	move.l 4(a6),-(a6)	; x
	move.l 4(a6),-(a6)	; y
	move.l d4,-(a6)
	GOSUB intfl			; x' en float
	cmp #3,sizeptr
	beq.s .float
	jsr (a4)					; ramŠne une donn‚e
	move.l d0,-(a6)
	GOSUB intfl			; y' en float
	bra.s .bb1
.float:
	move.l 4(a3),-(a6)
	move.l (a3),-(a6)		; y' en float
	addq.l #8,a3
.bb1:
	bsr _xy_bar					; x',y' coordonn‚es ‚cran
	move.l 4(a6),20(a6)	; met … jour le x avec x' pour rectangle suivant
	bsr v_bar
	movem.l (sp)+,d4-d7
	addq.l #1,d4
	cmp.l d4,d7
	bpl.s .encore
	addq.l #8,a6			; vire x,y
	tst.l d6
	bpl.s .no_grid2
	bsr _add_grid
.no_grid2:
	bsr gr_axes
.out:
	move.b xy_flag+1,xy_flag	; revient au mode pr‚c‚dent (absolute ou relative)
	bsr restaure_fill
	movem.l (sp)+,a4-a5
	rts

calc_minmax:
	move.l a3,a2
	movem.l d6-d7,-(sp)
	move.l d7,-(a6)
	GOSUB intfl
	move.l (a6),-(sp)
	move.l 4(a6),-(sp)	; sauve n
	moveq #-4,d0
	move.l d0,-(a6)
	GOSUB ffois2			; n/16
	bset #7,(a6)			; -n/16 = xmin
	move.l (sp)+,-(a6)
	move.l (sp)+,-(a6)	; r‚cupŠre n
	move.l 12(a6),-(a6)
	move.l 12(a6),-(a6)	; -n/16
	GOSUB fmoins				; xmax = n + 1/16 pour les marges !
	cmp #3,sizeptr
	beq .float
	move.l 4(sp),d1		; r‚cupŠre d7 comme compteur
	move.l #$7FFFFFFF,d2			; min par d‚faut
	move.l #$80000000,d3			; max par d‚faut
	bra.s .cmm1
.cmm0:
	jsr (a4)
	cmp.l d0,d2
	ble.s .cmm2
	move.l d0,d2		; nouveau min
.cmm2:
	cmp.l d0,d3
	bge.s .cmm1
	move.l d0,d3		; nouveau max
.cmm1:
	dbf d1,.cmm0
	move.l d3,-(sp)
	move.l d2,-(a6)
	GOSUB intfl
	move.l (sp)+,-(a6)
	GOSUB intfl
.fin:						; ici on a toujours (a6) = max et 8(a6) = min en float
	move.l a2,a3
	moveq #0,d0
	moveq #0,d1
	tst.b (a6)
	bpl.s .lb0			; max est positif, tout va
	movem.l d0-d1,(a6)	; sinon, max=0
.lb0:
	tst.b 8(a6)
	bmi.s .lb1			; min est n‚gatif, tout va
	movem.l d0-d1,8(a6)	; sinon, min=0
.lb1:
	move.l 4(a6),-(a6)
	move.l 4(a6),-(a6)	; max
	move.l 20(a6),-(a6)
	move.l 20(a6),-(a6)	; min
	GOSUB fmoins				; E=max-min, ‚tendue
	moveq #-4,d0
	move.l d0,-(a6)
	bsr ffois2				; E/16 pour la marge
	move.l (a6),-(sp)
	move.l 4(a6),-(sp)	; sauvegarde
	GOSUB fplus				; max+E/16 = ymax
	bsr fswap
	move.l (sp)+,-(a6)
	move.l (sp)+,-(a6)
	GOSUB fmoins				; min-E/16 = ymin
	GOSUB fswap
	bsr gr_window			; envoie xmin, xmax, ymin, ymax pour r‚gler la fenˆtre !
	movem.l (sp)+,d6-d7
	rts
.float:
	move.l #$7fefffff,d0
	moveq #-1,d1
	move.l d1,-(a6)
	move.l d0,-(a6)	; min par d‚faut = plus grande valeur
	bset #31,d0
	move.l d1,-(a6)
	move.l d0,-(a6)	; max par d‚faut = plus petite valeur
	move.l 4(sp),-(sp)	; r‚cupŠre D7 et le remet comme compteur
	bra.s .fff1
.fff0:
	move.l 4(a6),-(a6)
	move.l 4(a6),-(a6)	; duplique max
	move.l 4(a3),-(a6)
	move.l (a3),-(a6)		; valeur courante
	bsr fsup
	tst.l (a6)+				; max>x ?
	bne.s .fff2				; oui donc rien … changer
	move.l (a3),(a6)
	move.l 4(a3),4(a6)	; sinon, nouveau max
.fff2:
	move.l 12(a6),-(a6)
	move.l 12(a6),-(a6)	; duplique min
	move.l 4(a3),-(a6)
	move.l (a3),-(a6)		; valeur courante
	bsr fsup
	tst.l (a6)+				; min>x
	beq.s .fff3				; non, donc rien … changer
	move.l (a3),8(a6)
	move.l 4(a3),12(a6)	; sinon, nouveau min
.fff3:
	addq.l #8,a3			; ‚l‚ment suivant
.fff1:
	subq.l #1,(sp)
	bpl.s .fff0
	addq.l #4,sp			; vire le compteur
	bra .fin



	; dy addr1 addr2... addrk k n t gr_barg
	; comme gr_bar sauf paramŠtre dy:
	; c'est le pas de trac‚ de la grille sur l'axe vertical:
	;  si dy<0, mettre la grille sous le graphique
	;  si dy>0, mettre la grille sur le graphique

	SAUT
gr_sbarg:
	moveq #0,d6
	bset #31,d6		; marqueur grille
	bset #30,d6		; barres empil‚es
	bra.s _gr_sbar_comm

	; addr1 addr2... addrk k n t gr_sbar
	; c'est la fenˆtre en cours qui sert de rectangle
	; n valeurs en addr (taille selon size)
	; t=type 1,2,3,4
	; 4=1 … 8 remplissages
	; 2=9 … 24 motifs
	; 3=1 … 12 hachures
	; 1=couleurs de 2 … 15
	; 0=ne pas changer les r‚glages de remplissage


	SAUT
gr_sbar:
	moveq #0,d6		; pas de grille, bit31 = 0
	bset #30,d6		; barres empil‚es
_gr_sbar_comm:
	movem.l a4-a5,-(sp)
	move.l a4,_sauve_a4
	move.b xy_flag,xy_flag+1
	sf xy_flag				; mode absolu
	bsr gr_init
	ble .out			; si d7<=0 pas de graphique (d7= nombre de donn‚es)
						; idem si k=0
	movem.l d6-d7,-(sp)
	bsr calc_pminmax
	move.l a4,-(sp)
	move.l _sauve_a4(pc),a4
	bsr _calc_coeffs
	move.l a4,_sauve_a4
	move.l (sp)+,a4
	movem.l (sp)+,d6-d7
	tst.l d6				; grille?
	bpl.s .no_grid
	bclr #7,(a6)		; valeur absolue de dy
	beq.s .no_grid		; dy>0 donc par dessus le graphique
	bsr _add_grid		; car la grille se sert de A4 comme pointeur de pile
.no_grid:
	movem.l d6-d7,-(sp)
	moveq #0,d0
	move.l d0,-(a6)
	move.l d0,-(a6)	; float x=0
	move.l d0,-(a6)
	move.l d0,-(a6)	; float y=0
	bsr _xy_bar				; vers coordonn‚es ‚cran sur la pile, x

	moveq #1,d4			; compteur
	movem.l (sp)+,d6-d7
.encore:
	move.l (a6),d0		; y0 sauv‚
	move.l d0,-(a6)	; y- entier
	clr.l -(a6)
	clr.l -(a6)			; y- float
	move.l d0,-(a6)	; y+ entier
	clr.l -(a6)
	clr.l -(a6)			; y+ float
	move.l d4,-(a6)
	movem.l d4/d6/d7,-(sp)
	GOSUB intfl			; x' en float
	bsr .x				; x' en ‚cran
	movem.l (sp)+,d4/d6/d7
	moveq #100,d5		; remet style … z‚ro
.pile:
	bsr next_fill
	movem.l d4-d7,-(sp)
	move.l (a2),d0
	beq.s .boucle
	move.l d0,a3		; pointeur
	move.l (a6),-(a6)	; duplique x'
	tst.b gr3_angle
	beq.s .no_off1
	subq.l #1,(a6)	; d‚calage de 1 si couleur, sinon 0
.no_off1:
	cmp #3,sizeptr
	beq.s .float
	jsr (a4)					; ramŠne une donn‚e
	move.l d0,-(a6)
	GOSUB intfl			; y' en float
	bra.s .bb1
.float:
	move.l 4(a3),-(a6)
	move.l (a3),-(a6)		; y' en float
	addq.l #8,a3
.bb1:
	move.l a3,(a2)+		; acualise le pointeur
	tst.b (a6)				; valeur n‚gative?
	bmi.s .negatif
	lea 16(a6),a3			; pointe sur y+
	bra.s .bb2
.negatif:
	lea 28(a6),a3			; pointe sur y-
.bb2:
	move.l 4(a3),-(a6)
	move.l (a3),-(a6)		; prend y+-
	GOSUB fplus				; ajoute la donn‚e
	move.l (a6),(a3)+
	move.l 4(a6),(a3)+	; actualise y+-
	bsr .y					; y' en point ‚cran
	move.l 40(a6),-(a6)	; x
	tst.b gr3_angle
	beq.s .no_off2
	addq.l #1,(a6)			; d‚calage de 1 si couleur
.no_off2:
	move.l (a3),-(a6)		; y
	move.l 8(a6),(a3)		; et remplace y+- par y'
	bsr v_bar				; trace le rectangle
	movem.l (sp)+,d4-d7
	addq.l #1,d5			; motif/couleur suivant
	bra.s	.pile
.boucle:
	move.l (a6)+,d0		; le x'
	lea 24(a6),a6			; d‚pile y+ float, y+ ‚cran, y- float, y- ‚cran
	move.l d0,4(a6)		; le x' remplace le x actuel
	move.l 4(a2),a2		; revient sur le premier tableau
	movem.l (sp)+,d4-d7
	addq.l #1,d4
	cmp.l d4,d7
	bpl .encore
	addq.l #8,a6			; vire x, y0 sauv‚
	tst.l d6
	bpl.s .no_grid2
	bsr.s _add_grid
.no_grid2:
	bsr gr_axes
.out:
	move.b xy_flag+1,xy_flag	; revient au mode pr‚c‚dent (absolute ou relative)
	bsr restaure_fill
	movem.l (sp)+,a4-a5
	rts
.y:
	move.l a4,-(sp)
	move.l _sauve_a4(pc),a4
	bsr y_topage
	move ptsin+6,-(a6)
	clr -(a6)
	move.l (sp)+,a4
	rts
.x:
	move.l a4,-(sp)
	move.l _sauve_a4(pc),a4
	bsr x_topage
	move ptsin+4,-(a6)
	clr -(a6)
	move.l (sp)+,a4
	rts

	; routines communes aux gr_(p)bar(g)

_xy_bar:
	move.l a4,-(sp)
	move.l _sauve_a4(pc),a4
	bsr xy_topage
	lea ptsin+4,a0
	move (a0)+,-(a6)
	clr -(a6)
	move (a0)+,-(a6)
	clr -(a6)
	move.l (sp)+,a4
	rts
_sauve_a4: dc.l 0
_add_grid:
	bclr #31,d6					; ne faire qu'une fois !
	clr.l -(a6)
	move.l #$3FF00000,-(a6)	; empile 1.0
	GOSUB fswap
	movem.l d4-d7/a2-a5,-(sp)
	moveq.l #2,d0
	move.l d0,-(a6)
	bsr vswr_mode
	move.l _sauve_a4(pc),a4
	bsr gr_grid
	move sauve_fill_data+8(pc),-(a6)
	clr -(a6)
	bsr vswr_mode
	movem.l (sp)+,d4-d7/a2-a5
	rts


calc_pminmax:
	movem.l d6-d7,-(sp)
	move.l d7,-(a6)
	GOSUB intfl
	move.l (a6),-(sp)
	move.l 4(a6),-(sp)	; sauve n
	moveq #-4,d0
	move.l d0,-(a6)
	GOSUB ffois2			; n/16
	bset #7,(a6)			; -n/16 = xmin
	move.l (sp)+,-(a6)
	move.l (sp)+,-(a6)	; r‚cupŠre n
	move.l 12(a6),-(a6)
	move.l 12(a6),-(a6)	; -n/16
	GOSUB fmoins				; xmax = n + 1/16 pour les marges !
	move.l (a2),-4(a2)	; conserve le premier pointeur
	cmp #3,sizeptr
	beq .float
	move.l 4(sp),d1		; r‚cupŠre d7 comme compteur
	move.l d1,-(sp)
	moveq.l #0,d2			; min par d‚faut
	moveq.l #0,d3			; max par d‚faut
	bra.s .cmm1
.cmm0:
	moveq #0,d6			; somme +
	moveq #0,d7			; somme -
.cmm5:
	move.l (a2),d1		; pointeur sur tableau suivant
	beq.s .cmm3			; si 0, fin de liste
	move.l d1,a3		; sinon...
	jsr (a4)				; r‚cupŠre donn‚e
	move.l a3,(a2)+	; met … jour le pointeur
	tst.l d0
	bmi.s .cmm4
	add.l d0,d6			; si >0, somme +
	bra.s .cmm5
.cmm4:
	add.l d0,d7			; si <0, somme -
	bra.s .cmm5
.cmm3:
	move.l 4(a2),a2	; retour au d‚but de liste
	cmp.l d7,d2
	ble.s .cmm2
	move.l d7,d2		; nouveau min
.cmm2:
	cmp.l d6,d3
	bge.s .cmm1
	move.l d6,d3		; nouveau max
.cmm1:
	subq.l #1,(sp)
	bpl.s .cmm0
	addq.l #4,sp		; vire le compteur
	move.l d3,-(sp)
	move.l d2,-(a6)
	GOSUB intfl
	move.l (sp)+,-(a6)
	GOSUB intfl
.fin:						; ici on a toujours (a6) = max et 8(a6) = min en float
	move.l -4(a2),d0	; a1 sauv‚
	sub.l (a2),d0		; d‚calage par la lecture des donn‚es
.cmm6:
	tst.l (a2)			; fin de liste?
	beq.s .cmm7
	add.l d0,(a2)+		; remet le pointeur au d‚but
	bra.s .cmm6
.cmm7:
	move.l 4(a2),a2	; revient sur le d‚but du tableau
	moveq #0,d0
	moveq #0,d1
	tst.b (a6)
	bpl.s .lb0			; max est positif, tout va
	movem.l d0-d1,(a6)	; sinon, max=0
.lb0:
	tst.b 8(a6)
	bmi.s .lb1			; min est n‚gatif, tout va
	movem.l d0-d1,8(a6)	; sinon, min=0
.lb1:
	move.l 4(a6),-(a6)
	move.l 4(a6),-(a6)	; max
	move.l 20(a6),-(a6)
	move.l 20(a6),-(a6)	; min
	GOSUB fmoins				; E=max-min, ‚tendue
	moveq #-4,d0
	move.l d0,-(a6)
	GOSUB ffois2				; E/16 pour la marge
	move.l (a6),-(sp)
	move.l 4(a6),-(sp)	; sauvegarde
	GOSUB fplus				; max+E/16 = ymax
	GOSUB fswap
	move.l (sp)+,-(a6)
	move.l (sp)+,-(a6)
	GOSUB fmoins				; min-E/16 = ymin
	GOSUB fswap
	bsr gr_window			; envoie xmin, xmax, ymin, ymax pour r‚gler la fenˆtre !
	movem.l (sp)+,d6-d7
	rts
.float:
	clr.l -(a6)
	clr.l -(a6)				; min par d‚faut 0
	clr.l -(a6)
	clr.l -(a6)				; max par d‚faut 0
	move.l 4(sp),-(sp)	; r‚cupŠre D7 et le remet comme compteur
	bra .fff1
.fff0:
	clr.l -(a6)
	clr.l -(a6)				; somme -
	clr.l -(a6)
	clr.l -(a6)				; somme +
.fff6:
	move.l (a2),d0
	beq.s .fff4				; sommes finies
	move.l d0,a3			; pointeur
	tst.b (a3)
	bmi.s .fff5				; n‚gatif, ajouter … somme -
	move.l 4(a3),-(a6)
	move.l (a3),-(a6)		; valeur courante
	GOSUB fplus				; met … jour somme +
	bra.s .fff7
.fff5:
	move.l 12(a6),-(a6)
	move.l 12(a6),-(a6)	; duplique somme -
	move.l 4(a3),-(a6)
	move.l (a3),-(a6)		; valeur courante
	GOSUB fplus
	move.l (a6)+,12(a6)
	move.l (a6)+,12(a6)	; met … jour somme -
.fff7:
	addq.l #8,(a2)+		; r‚el suivant
	bra.s .fff6
.fff4:
	move.l 4(a2),a2		; retour au d‚but de liste
	move.l 20(a6),-(a6)
	move.l 20(a6),-(a6)	; duplique max
	move.l 12(a6),-(a6)
	move.l 12(a3),-(a6)	; somme +
	GOSUB fsup
	tst.l (a6)+				; max>somme + ?
	bne.s .fff2				; oui donc rien … changer
	move.l (a6),16(a6)
	move.l 4(a6),20(a6)	; sinon, nouveau max
.fff2:
	addq.l #8,a6			; vire somme +
	move.l 20(a6),-(a6)
	move.l 20(a6),-(a6)	; duplique min
	move.l 12(a6),-(a6)
	move.l 12(a6),-(a6)	; somme -
	GOSUB fsup
	tst.l (a6)+				; min> somme -
	beq.s .fff3				; non, donc rien … changer
	move.l (a6),16(a6)
	move.l 4(a6),20(a6)	; sinon, nouveau min
.fff3:
	addq.l #8,a6			; vire somme -
.fff1:
	subq.l #1,(sp)
	bpl .fff0
	addq.l #4,sp			; vire le compteur
	bra .fin

	SAUT
gr_bar_hlabel:
	bsr sauve_text			; attributs texte en cours
	lea gr3_angle,a3
	move.l (a6)+,d0
	move.w d0,(a3)+		; nombre de labels
	move.l (a6)+,d0
	move.w d0,(a3)+		; nombre de caractŠres par label
	move.l (a6)+,(a3)+	; adresse chaine
	move.l a6,_sauve_a4	; pour sortir proprement … n'importe quel moment
	moveq #0,d0
	bsr set_label_common	
	bsr set_font_size		; renvoie A2 = fenetre
	moveq #0,d0
	move 2(a2),d0			; y fenetre
	add 6(a2),d0			; y+h
	subq #1,d0				; y+h-1 = derniŠre ligne
	move.l d0,-(a6)		; le y du bas
	move.l 32(a2),-(a6)
	move.l 28(a2),-(a6)	; t = xmax-xmin = taille horizontale r‚elle
	moveq #3,d0
	move.l d0,-(a6)
	GOSUB ffois2				; t * 2^3 = 8*t
	move -8(a3),d0			; nombre de labels
	muls #9,d0
	move.l d0,-(a6)		; 9*n
	GOSUB intfl
	GOSUB fdiv					; calcule mon dx = 8t/9n
	move.l 4(a6),-(a6)
	move.l 4(a6),-(a6)	; duplique dx
	moveq #-1,d0
	move.l d0,-(a6)
	GOSUB ffois2				; dx/2 comme x de d‚part !
	bra.s .boucle
.encore:
	bsr.s get_one_string
	beq.s .fin				; c'est fini !
	move.l 4(a6),-(a6)
	move.l 4(a6),-(a6)	; duplique x r‚el
	bsr x_topage			; r‚cupŠre x ‚cran
	move.l d0,-(a6)		; sur la pile
	move.l 20(a6),-(a6)	; y ‚cran
	move.l a3,-(a6)		; chaine
	bsr v_gtext				; affiche !
	move.l 12(a6),-(a6)
	move.l 12(a6),-(a6)	; duplique dx
	GOSUB fplus				; et l'ajoute au x courant !	
.boucle:
	subq #1,-8(a3)			; le compteur
	bpl.s .encore
.fin:
	move.b xy_flag+1,xy_flag	; retour au mode courant
	lea 16(a4),a4			; d‚pile coeffs
	move.l _sauve_a4,a6	
	bsr restaure_text
	rts

	; renvoie MI si Ok
	; renvoie EQ si fin
	; en entr‚e a3 pointe sur :
	; -6 = WORD nombre de caractŠres par sous chaine
	; -4 = LONG adresse courante dans la chaine
	; 0 ici seront d‚pos‚s les caractŠres
	; en sortie l'adresse est mise … jour
	; a3 pointe sur la sous chaine (les espaces de fin sont enlev‚s)
	
	
get_one_string:
	move.l -4(a3),a0		; pointeur dans la chaŒne
	move -6(a3),d7			; nombre de caractŠres
	move.l a3,a1			; chaŒne temporaire
	bra.s .lb0
.lb1:
	move.b (a0)+,d0
	beq.s .lb2
	move.b d0,(a1)+	
.lb0:
	dbf d7,.lb1
	bra.s .lb3
.lb2:							; ici on a rencontr‚ un z‚ro !
	subq.l #1,a0
	cmp.l a3,a1
	beq.s .fin				; chaine vide, on termine !
.lb3:
	cmp.l a1,a3
	beq.s .lb4
	cmp.b #' ',-1(a1)		; enlŠve les espaces de fin
	bne.s .lb4
	subq.l #1,a1
	bra.s .lb3
.lb4:
	clr.b (a1)
	move.l a0,-4(a3)		; met … jour le pointeur
	moveq #-1,d7
.fin:
	rts

	; d0 = x000 000 nnnn nnnn
	; nnnnnnnn = d‚calage dans ".donn‚es"
	; bit 31 pour garder mode relatif et ne pas faire _calc_coeffs
	; (bit 31 pour les gr_pie)
	
set_label_common:
	lea .donnees(pc,d0.w),a2
	move.b xy_flag,xy_flag+1
	move.l d0,-(sp)		; bit 31 ?
	smi xy_flag				; si oui, mode relatif, sinon mode absolu
	move (a2)+,-(a6)
	clr -(a6)
	bsr vst_rotation		; angle
	move (a2)+,-(a6)
	clr -(a6)
	move (a2)+,-(a6)
	clr -(a6)
	bsr vst_alignment		; alignement en bas ou … gauche
	move (a2)+,-(a6)
	clr -(a6)
	bsr vswr_mode			; transparent ou replace
	tst.l (sp)+				; bit 31 ?
	bmi.s .out
	bsr _calc_coeffs		; sur la pile a4 !
.out:
	move.l fenetre,a2
	rts
.donnees:
	dc.w 0,1,4,2			; horizontal : angle 0, alignement 1,4 et mode transparent
	dc.w 900,1,2,1			; vertical:  angle 900, alignement 1,2 et mode replace
	dc.w 0,1,2,1			; titre:       angle 0, alignement 1,2 et mode replace


	; calcule la plus petite taille pour tous les labels (vert/hor)
	; et s‚lectionne la fonte en cons‚quence
	
set_font_size:
	move.l fenetre,a2
	moveq #0,d0
	moveq #0,d1
	move 4(a2),d0			; largeur
	move 6(a2),d1			; hauteur
	cmp d1,d0
	bmi.s .lb0
	move d1,d0				; conserve min(l,h)
.lb0:
	divs #18,d0				; la bordure c'est 1/18 de la taille
	move sauve_text_data+2(pc),d1	; hauteur actuelle de caractŠre
	cmp d1,d0
	bpl.s .fin				; assez de place !
	moveq #13,d1			; fonte 8*16
	cmp d1,d0
	bgt.s .set
	moveq #6,d1
	cmp d1,d0
	bgt.s .set
	moveq #4,d1
.set:
	move.l d1,-(a6)
	bsr vst_height
.fin:
	rts	

	SAUT
gr_bar_vlabel:
	bsr sauve_text			; r‚cupŠre les attributs de texte
	moveq #8,d0
	bsr set_label_common ; renvoie A2 = fenetre
	move.l (a6)+,a3		; chaine … afficher
	move (a2),-(a6)
	clr -(a6)				; x bordure fenetre
	move 6(a2),d0			; h
	lsr #1,d0				; h/2
	add 2(a2),d0			; y+h/2
	move d0,-(a6)
	clr -(a6)				; coordonn‚e y
	move.l a3,-(a6)		; chaine
	bsr set_font_size		; calcule la taille de la fonte...!
_finvt:
	bsr v_gtext
	lea 16(a4),a4
	bsr restaure_text
	rts	
	
	SAUT
gr_bar_title:
	bsr sauve_text			; r‚cupŠre les attributs de texte
	moveq #16,d0
	bsr set_label_common	; renvoie A2 = fenetre
	bsr set_font_size
	move.l (a6)+,a3		; chaine … afficher
	moveq #0,d0
	move 4(a2),d0			; l
	lsr #1,d0
	add (a2),d0				; x+l/2
	move.l d0,-(a6)
	move 2(a2),d0
	move.l d0,-(a6)		; y	
	move.l a3,-(a6)		; chaine
	bra.s _finvt

	; x,y,w,h sur la pile et remet en x,y,x',y' en tenant compte de xy_flag (abs/rel)
	SAUT
tovdi:
	moveq #0,d0			; offset par d‚faut
	tst.b xy_flag
	beq.s .lb0			; mode absolu
	move.l fenetre,a0
	move.l (a0),d0		; x,y fenetre
.lb0:
	movem.l (a6)+,d1-d4	; d1=h,d2=w,d3=y,d4=x
	sub d0,d3
	swap d0
	sub d0,d4
	add.l d3,d1
	add.l d4,d2
	subq.l #1,d1
	subq.l #1,d2
	movem.l d1-d4,-(a6)
	rts

	; x,y,x',y' sur la pile et revient … x,y,w,h en tenant compte de xy_flag
	SAUT
toaes:
	moveq #0,d0			; offset par d‚faut
	tst.b xy_flag
	beq.s .lb0			; mode absolu
	move.l fenetre,a0
	move.l (a0),d0		; x,y fenetre
.lb0:
	movem.l (a6)+,d1-d4	; d1=y',d2=x',d3=y,d4=x
	cmp.l d3,d1
	bpl.s .lb1
	exg.l d1,d3		; s'assure que y'>y
.lb1:
	cmp.l d4,d2
	bpl.s .lb2
	exg.l d4,d2		; et que x'>x
.lb2:
	sub.l d3,d1
	sub.l d4,d2
	addq.l #1,d1			; h
	addq.l #1,d2			; w
	add d0,d3
	swap d0
	add d0,d4
	movem.l d1-d4,-(a6)
	rts

	COPIE sizei,y235,1
sizei:
	moveq #0,d0
	move sizeptr,d0
	move.l d0,-(a6)
y235:
	rts

	end

detect_aes:
   lea global,a0
   moveq #0,d0
   move (a0),d1
   cmp #$400,d1
   bmi.s .finaes					; AES<4.00, donc pas d'autre appel
	GEM_AES _appl_getinfo 		; c'‚tait avec intin = 96
	lea addrin,a0
	move.l (a0),a0					; adresse de l'identifiant
	cmp.l #$400,a0
	bmi.s .finaes					; pas l'air d'etre une adresse valide
	moveq #1,d0
	movem.l (a0)+,d1-d2
	cmp.l #'   X',d1
	bne.s .autreaes
	cmp.l #'aAES',d2
	beq.s .finaes
.rate:
	moveq #0,d0
	bra.s .finaes
.autreaes:
	moveq #2,d0
	cmp.l #'   M',d1
	bne.s .rate
	cmp.l #'yAES',d2
	bne.s .rate
.finaes:
	move.l d0,global+32
	rts


   END
