include "FLIB.H" include "GRAPHLIB.H" include "HEXLIB.H" include "TIOS.H" xdef _main xdef _comment ;------------------------------------------------------------- ; TEXT TESTER V1.0 ; Program made by VIVES Fabien ; EMail : vives@univ-aix.fr ; For Further informations see the file README.TXT ;------------------------------------------------------------- ; Program made with Fargo Program Editor v2.0 ; Benoit SCHERRER - p.c.scherrer@wanadoo.fr ;------------------------------------------------------------- ;************************** MACRO **************************** WriteStr MACRO ; Syntax : x/y/Color/String move.w \3,-(a7) ;we put the color in the Stack. pea \4(pc) ;we put the String to Display in the Stack. move.w \2,-(a7) ;we put the Y-coordinate in the Stack. move.w \1,-(a7) ;we put the X-coordinate in the Stack. jsr tios::DrawStrXY ;we call the subroutine in TIOS. lea 10(a7),a7 ;we restore the Stack of 10 = 2+4+2+2 ENDM ;***************** Start of FARGO II Program ****************** _main: movem.l d0-d2/a0-a1,-(a7) ;we save the registers we're going to modify. move.w #0,cmptr ;initialisation of " cmptr ". jsr flib::clr_scr ;we clear the screen. move.w #0,-(a7) ;we put the Font 0 in the Text.( smallest Font ). jsr tios::FontSetSys ;we call the subroutine in TIOS. lea 2(a7),a7 ;we take the stack back of 2. WriteStr #0,#0,#1,intro ;we display " intro ". lea phrase(pc),a1 ;A1 points at var " phrase ". clr.l (a1) ;we clear the longword which A1 points at. add.w #4,a1 ;we add 4 bytes at A1. clr.l (a1) ;we clear the longword which A1 points at. Now we are ;sure that var " phrase " is entirely cleared. sub.w #4,a1 ;A1 points at " phrase ". move.w #2,-(a7) ;we put the Font 2 in the Stack. jsr tios::FontSetSys lea 2(a7),a7 ;we restore the Stack of 2. ;NOW WE'RE GOING TO DISPLAY THE LETTERS AS SOON AS THEY ARE PRESSED, AND WE ;STORE IT IN THE VAR " PHRASE ". saisie: jsr flib::idle_loop ;this subroutine waits for the user to press a key. ;it returns the ASCII value of the key. cmp.w #13,d0 ;is it ENTER ? beq finsaisie ;if it is go to " finsaisie ". cmp.w #257,d0 ;is it BACKSPACE ? beq backspce ;if it is go to " backspce". add.w #1,cmptr ;we add 1 to the counter. This counter limits the ;number of letters of the word to 8. cmp.w #9,cmptr beq retour ;if the counter equal 9 then go to " retour ". move.b d0,(a1)+ ;we put the letter where A1 points at i.e. in the ;var " phrase " and we add 1 Byte to A1. WriteStr #10,#10,#1,phrase ;we display var " phrase ". I do not take time to erase ;the screen. We write above. I mean, if there was ;already the word " tr " displayed, and I press the key ; " y ". Then we display the word " try " above " tr ". bra saisie ;we go back to " saisie " to pursue the entering of the ;word. retour: sub.w #1,cmptr ;we substract 1 to " cmptr " because before we added 1. ;we are in " retour " because we have reached the limit ;of 8 letters for the word. While the user doesn't press ;ENTER to end, or BACKSPACE to erase a letter, we go ;there. bra saisie ;go back to " saisie ". backspce: cmp.w #0,cmptr ;we check if there is at least one letter to erase.If there ;isn't, " cmptr " at 0. beq saisie ; cmptr=0 ? so go back at " saisie ". sub.w #1,cmptr ;we erase a letter, so we have to substract 1 to " cmptr ". WriteStr #10,#10,#2,phrase ;I don't want to clear ALL the screen, so we just erase ;the phrase. For this, we rewrite the var " phrase " with ;the color 2. move.b #0,-(a1) ;we substract 1 Byte to A1, and we put 0 where A1 points ;to. WriteStr #10,#10,#1,phrase ;we display the var " phrase ". bra saisie finsaisie: move.w #0,ancfont ;initialisation of the var " ancfont ". move.w #50,Posx ;------------------------------------- " Posx ". move.w #50,Posy ;------------------------------------- " Posy ". move.w #1,color ;------------------------------------- " color ". boucle1: jsr flib::clr_scr ;we clear the screen. WriteStr Posx,Posy,color,phrase ;we display the var " phrase ". boucle2: jsr flib::idle_loop ;we wait for a letter to be pressed. cmp.w #264,d0 ; ESC ? beq fini cmp.w #268,d0 ; F1 ? beq Fct1 cmp.w #269,d0 ; F2 ? beq Fct2 cmp.w #270,d0 ; F3 ? beq Fct3 cmp.w #271,d0 ; F4 ? beq Fct4 cmp.w #272,d0 ; F5 ? beq Fct5 cmp.w #337,d0 ; CURSOR TO THE LEFT ? beq gauche cmp.w #338,d0 ; CURSOR TO THE TOP ? beq haut cmp.w #340,d0 ; CURSOR TO THE RIGHT ? beq droite cmp.w #344,d0 ; CURSOR TO THE BOTTOM ? beq bas cmp.w #273,d0 ; F6 ? beq Fct6 cmp.w #13,d0 ; ENTER ? beq Enter bra boucle2 haut: cmp.w #0,Posy ;we check if we are at the top of the screen. beq boucle2 ;if yes, we go back to " boucle2 ". sub.w #1,Posy bra boucle1 bas: cmp.w #127,Posy ;are we at the bottom of the screen ? beq boucle2 add.w #1,Posy bra boucle1 gauche: cmp.w #0,Posx ;are we at the left border of the screen ? beq boucle2 sub.w #1,Posx bra boucle1 droite: cmp.w #239,Posx ;are we at the right border of the screen ? beq boucle2 add.w #1,Posx bra boucle1 Enter: clr.l d0 move.w #2,-(a7) ;we put the Font 2 in the Stack. jsr tios::FontSetSys ;We set system's Font. This subroutine returns in D0 ;the value of the Font before we change. lea 2(a7),a7 ;we restore the Stack of 2. move.w d0,ancfont ;we save the ancient Font in " ancfont ". jsr flib::clr_scr WriteStr #40,#50,#1,infos ;we display the text " infos ". move.w Posx,d0 ;we put in D0 the number we want to convert in a ;decimal String. moveq #3,d1 ;we put in D1 the size of the number. Here 3 digits. lea strbuf(pc),a0 ;we load in A0 where is the var " strbuf ". bsr ConvStr ;we go to the Convert Routine. WriteStr #60,#60,#1,strbuf ;we display the result. move.w Posy,d0 ;Same thing as above for Posy. moveq #3,d1 lea strbuf(pc),a0 bsr ConvStr WriteStr #90,#60,#1,strbuf jsr flib::idle_loop ;we wait for a key to be pressed. move.w ancfont,-(a7) ;we load the Font we had before. jsr tios::FontSetSys lea 2(a7),a7 bra boucle1 Fct1: move.w #0,-(a7) ;we put the Font 0 in the Stack. bra suite Fct2: move.w #1,-(a7) ;we put the Font 1 in the Stack. bra suite Fct3: move.w #2,-(a7) ;we put the Font 2 in the Stack. bra suite Fct4: move.w #0,color ;we put the color 0 in var " color ". bra boucle1 Fct5: move.w #1,color ;we put the color 1 in var " color ". bra boucle1 Fct6: move.w #2,color ;we put the color 2 in var " color ". bra boucle1 suite: jsr tios::FontSetSys ;we go to the subroutine that changes the System Font lea 2(a7),a7 ;we restore the Stack of 2. bra boucle1 fini: movem.l (a7)+,d0-d2/a0-a1 ;we take back the registers we have modified. rts ;******************************************* ROUTINE ********************************************* ;I got this routine in the prog DUMBADV. ;This routine converts a number in a Decimal String. ;a0 points at " strbuf ". ;d1 how many digits the number will be. Here it will be 3 digits. ;d0 the number we want to convert. ConvStr: adda.l d1,a0 ;a0 points now at "adresse de strbuff " + 3 bytes. clr.b (a0) subq.b #1,d1 ;d1 is a kind of counter. RepConv: divu #10,d0 ;we divide by ten, because we want the number in Base Ten. move.l d0,d2 ;In D0 : The upper word gets the remainder ;and the result is in the lower word. lsr.l #8,d2 lsr.l #8,d2 ;we shift twice to the right in order to have the upper word ;at the place of the lower word. ( The lower word is destroyed). add.b #48,d2 ;we add 48 to the remainder because the ASCII code of the ;key " 1 " for example is : 49. For " 2 " it's 50. move.b d2,-(a0) ;we substract 1 Byte to A0 and we put D2 where A0 points to. and.l #$FFFF,d0 ;sincerely, I really don't know why there is this line. Because ;it changes nothing in D0. If smne see why, please Email Me. dbra d1,RepConv ;we substract 1 to D1. If D1 equals " -1 ", we leave. rts ;go back to the prog. ;******************** Program Variables *********************** Posx dc.l 0 ;X-Coordinate of our word.. Posy dc.l 0 ;Y-Coordinate of our word. strbuf dc.l 0,0 ;this variable is necessary to store the Decimal String Posx or Posy. phrase dc.l 0,0 ;same as above, but it stores the word we want to display. cmptr dc.w 0 ;a counter. color dc.w 0 ;the color of our word. ancfont dc.w 0 ;in this variable we store the Font. intro dc.b "Type text to Display. ENTER to end. ( 8 letters max ).",0 infos dc.b "Position X / Y :",0 _comment dc.b "Text Tester v1.0",0 ;********************** End of Program ************************ end