Projet Paint pour MO5 en Forth

[__sam__]

Un optim simple:

Code : Tout sélectionner

02 *

devrait être écrit "DUP +".. Je ne sais pas si le LSL (assembleur) sera plus rapide que "DUP +", mais en tout cas j'aime assez la compacité que permet le Forth:

Code : Tout sélectionner

: 2x DUP + ;
: 4x 2x 2x ;
: 16x 4x 4x ;

C'est vraiment joli. Avec ces mots pour remplacer les produits, je suis sur que BITDUP sera encore plus rapide.

[Dominique]

A) Les premiers essais pour loupe 2X sont assez décevants ...

Test Loupe 2X

Loupe1.jpg (9.09 Kio) Consulté 3983 fois

Loupe2.jpg (9.63 Kio) Consulté 3983 fois

On va peut être essayer 4X .
@_sam_ , ta routine marche super. tu peux essayer de nous sortir un bitdupdup ???? ce serait chouette

Code : Tout sélectionner

ABCDEFGH ->  AAAABBBB   CCCCDDDD EEEEFFFF GGGGHHHH
             AAAABBBB   CCCCDDDD EEEEFFFF GGGGHHHH
             AAAABBBB   CCCCDDDD EEEEFFFF GGGGHHHH
             AAAABBBB   CCCCDDDD EEEEFFFF GGGGHHHH

B) de plus, le tracé du rectangle symbolisant la Loupe perturbe le FOND de couleur des dessins....

Loupe3.jpg (26.38 Kio) Consulté 3983 fois

Voici le code rajouté au programme pour la loupe

Code : Tout sélectionner

0 VARIABLE ADRSPRITE      
: BITDUP 00FF AND DUP 10 * OR 0F0F AND DUP 04 * OR 3333 AND DUP 02 * OR 5555 AND 3 * ;
: LIMITXY XA @ /8 2 MAX 26 MIN 8 * DUP 9 - XA ! DUP 8 + XNOW ! X1 ! YA @ 0B MAX  BD MIN DUP 0B - YA ! DUP  A + YNOW ! Y1 !  ;
: COPYSPRITE 4050 XA @ 1+ YA @ 1+ TROUVE-CELL DROP DUP ADRSPRITE ! DUP 190 + SWAP DO I FOND C@ OVER C! 14 + I FORME C@ OVER C! 13 -  28 +LOOP ;
: DRAWFOND 4050 DUP A + SWAP DO I C@  DUP 100 * + OVER OVER OVER 28 + FOND  ! ! 50 + LOOP  DROP ;
: DRAWFORME  405B DUP A + SWAP DO I C@ BITDUP OVER OVER OVER 28 + FORME   ! ! 50 + LOOP DROP ;     
: DRAWSPRITE ADRSPRITE @ DUP DRAWFOND DRAWFORME ;
: DRAWGLASS LIMITXY COPYSPRITE (DRAWRECT) DRAWSPRITE BEGIN KEYF 2E = UNTIL ; 
: ?GLASS 2E = IF 2E BEEP >COPIE-EC DRAWGLASS COPIE-EC> ENDIF ;
: ?INPUT KEYF COLOUR? UP DOWN LEFT RIGHT DUP ?RECT DUP ?ELLI DUP ?LINE DUP ?FILL DUP ?U DUP ?CIRC DUP ?KLEAR DUP ?GLASS DUP 19 = IF INPUT-MENU ENDIF ;                                                                                  
: MO4PAINT 7 0 COLOR DI INIT BEGIN ?INPUT TR @ NOT IF DRAW ENDIF FLASH FLASH E = UNTIL EI CLS ; 

[__sam__]

Ok, on va appeller cela BITQUAD, en fait cela consiste moralement à faire BITDUP deux fois dans le rang:

Code : Tout sélectionner

HEX
: BITQUAD ( ABCDEFGH -- AAAABBBBCCCCDDDDD EEEEFFFFGGGGHHHH )
00FF AND                    ( optionnel )
DUP 16 / BITDUP BITDUP      ( ABCDEFGH AAAABBBBCCCCDDDD )
OVER 000F AND BITDUP BITDUP ( AAAABBBBCCCCDDDD EEEEFFFFGGGGHHHH )
DECIMAL

le "16 /" risque d'être couteux. Il faudrait écrire une primitive de décalage à droite en ASM (LSR). Plus généralement parlant, j'ai le sentiment que cette routine n'est pas la plus efficace qu'il soit. Un algo à base de tests sera peut être plus efficace que de procéder par manipulations logico-aritmétiques. Mais bon au moins elle est compacte.

Pour éviter la bavure du rectangle de zoom, je pense qu'il faudrait aligner la loupe sur un multiple de 8 pixels horizontalement.

[Dominique]

Bonjour
@_sam_ merci. l'important c'est que ça marche, on optimisera ensuite. Comme nous arrivons à la fin et qu'il ne reste plus que la loupe et les copier*coller on optimisera bientôt.

Pour ce qui est du pixel de 8 c'est ce que fait

Code : Tout sélectionner

: LIMITXY XA @ /8 2 MAX 26 MIN 8 * ..........

Qui ajuste les limites de XA pour que le trait du rectangle ne se fasse pas dans le pixel. Mais je ne voulais pas faire un trait de 8 pixels. Mais j'ai fini par trouver la solution.

J'ai une rude journée : Limoges - Brive et montée à Rennes pour mettre en route du matériel et je n'aurai pas beaucoup de temps libre.

[__sam__]

Bonne route alors!

Je pense que le rectange de la loupe devrait être tracé sans altérer la RAM couleur. Ainsi il n'y aura plus de bavures. Autre possibilité: au lieu de faire des gros pavés de 4 pixels pour un pixel d'origine, on peut laisser un pixel en couleur de fond de sorte à faire apparaitre une grille symbolisant la loupe et les frontières de pixels:

Code : Tout sélectionner

................
.XXX.XXX.XXX.XXX
.XXX.XXX.XXX.XXX
.XXX.XXX.XXX.XXX
................
.XXX.XXX.XXX.XXX
.XXX.XXX.XXX.XXX
.XXX.XXX.XXX.XXX

[Dominique]

Oui, ce serait vraiment du travail de pro.
Mais je vois un problème dû aux limitations graphiques du MO.
A l'intérieur des cellules on n'a droit qu'à deux couleurs
Celle du bit allumé qu'on appelle Encre
Celle du bit éteint qu'on appelle Fond.

Si dans une cellule le bit 1 vaut rouge, par exemple, et le bit 0 vert, on ne pourra pas faire du noir ...

[__sam__]

Oui, quand on veut avoir plus de deux couleurs: ca bave. C'est pour ca que je pense qu'il doit être possible de matérialiser le tour en ne touchant qu'à la mémoire forme. Plus précisément, si on dessine les lignes du tour en mode XOR uniquement dans la mémoire FORME, alors le tour se matérialisera par une inversion la couleur du fond et de la forme sans bavures.

Allez, pour le fun, voici une routine de BIT4x à base d'opération logico-arithmétique sans multiplication ni ASM:

Code : Tout sélectionner

HEX
: 2x DUP + ;
: 4x 2x 2x ;
: BIT4x ( xxxxxxxxxxxxEFGH -- EEEEFFFFGGGGHHHH )
000F AND           ( 000000000000EFGH
DUP 4x 4x 4x       ( 000000000000EFGH 0000EFGH000000 )
OR 0303 AND        ( 000000EF000000GH )
DUP 2x 4x          ( 000000EF000000GH 000EF000000GH000 )
OR 1111 AND        ( 000E000F000G000H )
DUP 4x 4x SWAP - ; ( EEEEFFFFGGGGHHHH c'est une multiplication par 15=16 - 1 )
( Nota: en utilisant plutôt DUP 4x 2x OVER - on aurait 0EEE0FFF0GGG0HHH car c'est une multiplication par 7 )

Une fois BIT4x défini, on peut rendre BITQUAD plus performant:

Code : Tout sélectionner

CREATE /16 ECC1 , 4756 , 4756 , 4756 , 4756 , 0EB4 , SMUDGE ( equivalent ASM de "16 /" )
: BITQUAD DUP /16 BIT4x SWAP BIT4x ; ( du coup BITQUAD est beaucoup plus petit! ) 
DECIMAL

[Dominique]

Heure d'aller diner ...

Voici ce que ça donne pour l'instant

bloggif_519d0d9e76640.gif (46.7 Kio) Consulté 3942 fois

[Dominique]

Je vais nommer celle-ci Version 2-6beta car elle est encore en test et sujette à améliorations.
Grâce à l'ami _sam_ nous avons une excellente procédure qui permet de créer l'effet loupe x2 et bientôt x4.
J'ai suivi ses observations et le rectangle s'affiche maintenant en négatif.
Je pense qu'il faudrait augmenter le nombre de lignes de la loupe.
Problèmes :
-la loupe n'est pas très visible dans les dessins coloriés comme par exemple
le drapeau du Brésil
-Les procédures qui utilisent DO ... LOOP pour la loupe sont très très lentes.... Il va falloir certainement
inclure du LM pour les rendre acceptables.
-Il faut vraiment insister sur la touche G pour sortir de la loupe.

Feed back pls .

Procédures rajoutées pour la Loupe

Code : Tout sélectionner

0 VARIABLE ADRSPRITE  
: BITDUP 00FF AND DUP 10 * OR 0F0F AND DUP 04 * OR 3333 AND DUP 02 * OR 5555 AND 3 * ; 
: LIMITXY XA @ /8 2 MAX 26 MIN 8 * DUP 9 - XA ! DUP 10 + XNOW ! X1 ! YA @ 0B MAX  BD MIN DUP 0B - YA ! DUP  A + YNOW ! Y1 !  ; 
: LOOPSPRITE DUP 190 + SWAP DO I FOND C@ OVER C! 0B + I FORME C@ OVER C! 0A -  28 +LOOP ;
: COPYSPRITE 4050 XA @ 1+ YA @ 1+ TROUVE-CELL DROP DUP ADRSPRITE ! LOOPSPRITE B + ADRSPRITE @ 1+ LOOPSPRITE DROP ; 
: DRAWFOND DUP A + SWAP DO I C@  DUP 100 * + OVER OVER OVER 28 + FOND ! ! 50 + LOOP  DROP ;                                                                                    
: DRAWFORME DUP A + SWAP DO I C@ BITDUP OVER OVER OVER 28 + FORME ! ! 50 + LOOP DROP ; 
: DRAWSPRITE ADRSPRITE @ DUP DUP DUP 4050 DRAWFOND 405B DRAWFORME 4065 DRAWFOND 4070 DRAWFORME ; 
: DRAWGLASS LIMITXY COPYSPRITE 1 NEGATIF ! (DRAWRECT) DRAWSPRITE BEGIN KEYF 2E = 2E BEEP (DRAWRECT) UNTIL ; 
: ?GLASS 2E = IF 2E BEEP XA @ YA @ >COPIE-EC 1 STEP ! DRAWGLASS COPIE-EC> YA ! XA ! ENDIF ; 

Modifs pour inclure la Loupe

Code : Tout sélectionner

: ?INPUT KEYF COLOUR? UP DOWN LEFT RIGHT DUP ?RECT DUP ?ELLI DUP ?LINE DUP ?FILL DUP ?U DUP ?CIRC DUP ?KLEAR DUP ?GLASS DUP 19 = IF INPUT-MENU ENDIF ;  
: MO4PAINT 7 0 COLOR DI INIT BEGIN ?INPUT TR @ NOT IF DRAW ENDIF FLASH FLASH E = UNTIL EI CLS ; DECIMAL

[Dominique]

Il y a un bug ! l'affichage colonne droite de la loupe ne se fait pas correctement.
Je pense qu'il faut corriger en rajoutant 1+ entre le deuxième et troisième DUP.:

Code : Tout sélectionner

: DRAWSPRITE ADRSPRITE @ DUP DUP 4050 DRAWFOND 405B DRAWFORME  1+ DUP 4065 DRAWFOND 4070 DRAWFORME ; 

A voir demain.

EDIT En fait c'est la ligne du dessus. Elle se trouve dans le screen 5 de la deuxième partie; Et ça marche

[__sam__]

AS tu une idée de pourquoi le DO...LOOP est lent? J'aurais cru que le code en LM derrière était assez efficace, mais ca ne doit pas être tout à fait le cas. Comment est encodé le DO LOOP ?

[Dominique]

Les deux bornes sont empilées dans la pile de retour du Forth.
BORNE-A BORNE-B DO - > Forth va chercher l'adresse de sa pile de retour. Il empile BORNE-A et BORNE-B
LOOP -> L'instruction LOOP desempile BORNE-A et BORNE-B, rajoute 1 à BORNE-B et verifie l'égalité. Si non egal, réempile les deux valeurs et fait un saut retour à DO.
+LOOP -> IDEM sauf que au lieu d'un +1 automatique, rajoute la valeurs contenue dans la pile de données.

c'est la gestion de cette pile R (retour) qui est fastidieuse.

J'ai bien pensé remplacer le LOOP par un BORNE-A BORNE-B BEGIN ...... 1+ OVER OVER = UNTIL ...

C'est à voir

[Dominique]

ça y est : J'ai fait une modif qui le rend beaucoup plus rapide : Il n'y a pas que le LOOP qui est long, il y a aussi le tracé du rectangle qui représente la Loupe.
J'avais introduit une variable STEP qui permet de faire le tracé des figures par sauts de la valeur STEP.
si STEP = 1 tous les traits sont tracés. En mettant STEP à 3 je ne fais qu'un point sur 3.
Et là le rectangle est encore bien visible, mais son tracé est 3 fois plus rapide

Code : Tout sélectionner

: ?GLASS 2E = IF 2E BEEP XA @ YA @ >COPIE-EC 1 STEP ! DRAWGLASS COPIE-EC> YA ! XA ! ENDIF ; 

deviendra

Code : Tout sélectionner

: ?GLASS 2E = IF 2E BEEP XA @ YA @ >COPIE-EC 3 STEP ! DRAWGLASS COPIE-EC> YA ! XA ! ENDIF ; 

je vais augmenter le nombre de lignes de la loupe x2 puis m'attaquer à la loupe x4.
Je pense faire la bascule loupe x2 vers loupe x4 et inversement par les touches + et -

[__sam__]

Est-ce que ces manips de copie de la pile de retour sur la pile donnée sont faits en FORTH eux même? (avec des <R et aurtres R>) Si c'est le cas, on pourrait redéfinir LOOP pour qu'il produise un LM évitant ces manips en FORTH en faire cela directement avec les registres du CPU. En gros un truc genre:

Code : Tout sélectionner

LOOP
   ldd  #1    ; ou ldd ,u++ en cas de +LOOP
   addd ,s
   std  ,s
   cmpd 2,s   ; comparaison avec la borne
   blt  ZZZ   ; dépassée ? non =>  retour au DO
   leas 4,s   ; oui => dépile des compteurs et bornes
   jmp  /NEXT ; et instruction suivante
ZZZ 
   jmp <adresse du DO>

Sinon pour le rectangle: tu peux le dessiner plein directement en masquant les cellules écrans. C'est pas trop complexe: XOR avec -1 pour les traits hauts et bas et XOR avec 16385 pour ajouter un pixel à gauche et à droite.

[Dominique]

Ce TEST permet de voir un peu plus près comment marche la compilation FORTH
OBS : DO et LOOP sont écrits en Forth et laissent leurs primitives (DO) et (LOOP) dans la mémoire de compilation

Voici le résultat de

: TEST 5 1 DO I . LOOP ;

Code : Tout sélectionner

84 			Longueur du mot TEST + 80
54 45 53 d4 		ASCII TES  T+80
7f 30			Adresse du mot précédent dans le dictionnaire
4d 70 			Adresse DOCOLON  - mis par :
46 9e 			Adresse du mot NUMBER qui lira la cellule suivante (0005)
00 05 			0005
4d 8e 			Adresse de la constante UN
4b 8d 			Adresse de la primitive (DO)
4b e6 			Adresse de I
50 32 			Adresse de .
4b ce			Adresse de (LOOP)
FFFA 			Valeur du saut retour vers DO ;
4c62			Valeur de la routine NEXT laissé par ;


         84			Longueur du mot (DO) + 80
         28 44 4f a9		ASCII (DO  )+80
         4b 6b 			Adresse du mot précédent dans le dictionnaire
4B8D     4b 8f 			Adresse execution de (DO)

4B8F 3706       PULU   A,B                 
4B91 3710       PULU   X                   
4B93 3416       PSHS   X,B,A               
4B95 0EB6       JMP    /$B6                



     81 		Longueur du mot I + 80
     ca 		ASCII I+80
     4b e2 		Adresse du mot précédent dans le dictionnaire
4BF0 4b f2 		Adresse execution de I
4BF2 EC64       LDD    $04,S              
4BF4 0EB4       JMP    /$B4               Pousse D ans la pile de données

 
     86 		Longueur du mot (LOOP) + 80
     28 4c 4f 4f 50 a9 	ASCII (LOOP  )+80
     4B97		Adresse du mot précédent dans le dictionnaire
     4BD0 		Adresse execution de (LOOP)
4BD0 CC0001     LDD    #$0001             
4BD3 E3E4       ADDD   ,S                 
4BD5 EDE4       STD    ,S                 
4BD7 10A362     CMPD   $02,S              
4BDA 2CE3       BGE    $4BBF              
4BDC ECA4       LDD    ,Y                 
4BDE 31AB       LEAY   D,Y                
4BE0 0EB6       JMP    /$B6     

4BBF 3122       LEAY   $02,Y              
4BC1 3264       LEAS   $04,S              
4BC3 0EB6       JMP    /$B6