' ' ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Source ®®EdiTex¯¯ ' Sweetel¿ (Version 2) ' SystŠme de composition vid‚otex ' * ' ½1992/93/94/95 ' Modifs 96/97 ' (Oct/Avr-Juin/Dec-Jan/) ¾,½X. Roche ' ALL RIGHT RESERVED ' Tous droits r‚serv‚s … l'auteur ' * ' Interface: WindTool¿ ½RX ' Evaluation: E-Val-N¿ ½RX ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' ' ' ' [Divisions entiŠres, RC 4 octets, select 4 octets, fonction: int] $m420000 $E+ $RC% $*% $%3 $S% $S $P> $F< $C $C+ ' ' Son de sweety: JMJ.INL (chronologie) Inline Swsound%,972 ' Mouse anim (sablier): 5(animations)*37(mots)*2(long.mot)=370o Inline M_anim%,444 ' Inline R40cl%,28 Inline R40st%,32 Inline Rlsl%,28 Inline Rlsr%,36 Inline Rinv%,24 Inline Rbn%,44 Inline Tst63%,36 Inline Wherest%,40 Inline Drawline%,108 Inline Hflip%,44 Inline Vflip%,126 Inline Ssright%,124 Inline Ssdown%,272 Inline Cache%,86 Inline Teststr%,72 Inline Indent%,246 Inline Blitc%,176 Inline Swmin%,174 Inline Swchar%,104 ' Inline Clrblk%,140 ' ' ///////////////////// ' Charger routines: ' My_load ' Edit ' \\\\\\\\\\\\\\\\\\\\\ ' Option Base 0 Defwrd "A-Z" Deflist 3 ' ' Notes: ' -------------------- ' Bios(2,1)= Inp(1) ' Bios(1,1)= Inp?(1) ' Bios(8,1)= Out?(1) ' -------------------- ' ++ -> optimis‚ ' -------------------- Startex: ! Pour Resume ' Gosub Main ' ' Procedure Main Linea!=True Vopen!=False ! fichier #5 ferm‚ pour l'instant Let Name$="Sweetel 2" Let Release$="2.50" Let Reldate$="1995-1997" Title$=Chr$(32)+Name$+" v"+Release$+" (c)'1995-97 " Atitle$=" "+Name$+" v"+Release$+Chr$(32) ' Set_multi!=True ! multitache pendant compilation Set_mtime%=8 ! toutes les 8 lignes Set_system&=0 ! gestion normale Set_end!=False ! ne pas stopper le programme huhu!! Set_mouse&=-1 ! defmouse non install‚ Set_critical!=False ! Etat non critique (m‚moire pleine) Set_mpoint%=0 ! point options menu Set_rmpoint%=0 ! point options menu raccourcis Set_progress!=True ! barre de % Linea!=True ! Pr‚sente … priori Set_send!=False ! On envoie pas yet ' ' -------------------- On error gosub Werror ' -------------------- ' Mem%=200000 ! K (fictif) Dims&=3000 ! Nb lignes Maxstr&=514 ! Nb max de caractŠres dans 1 lignes Limit%=32000 ! Nb d' octs critiques.. Lowlimit%=12000 ! Nb d' octs critiques en dessous desquels on ne peut plus ' rien faire! Dinstr&=9 ! Nb max d'instructions-1 (paramŠtres) ' ' 5chars (4 octets +1 de diff‚renc.) de contr“le plus un de s‚paration Tabi&=5+1 ' Page_id&=0 Actb&=0 ! Bloc 0 par d‚faut ' ' pr‚d‚finitions Slow!=False Ascii&=False Autosend!=False ! pas d'envoi en compile (F1) Speed&=0 Set_speed!=True ! prendre en compte vitesse Expert!=False Acc!=True ! accents ' Effect!=True ! effets graf_grow/shrink etc.. Effect!=False Efdesk!=True ! 'Sweetel' vectoriel comme arriŠre plan... Clr Find$,Undo$ Clr Maxi&,List$ ! nbr d'instr, liste = globaux Clr Lcomm$ Vcr!=False ! emul curs flag ' Recept!=True ! ‚mulation Emul!=True Answer!=True ' Segn!=True ! segments Segi!=True Afdrc!=True ! affichage DRCS ! ' Pic_x&=-1 ! Picture DRCS lining Pic_y&=-1 ' Drs_x&=16 ! start X/Y drcs Drs_y&=16 ' Emx&=4 ! pos ‚mulateur dans la fenˆtre Emy&=4 ' Quote$=Chr$(34) ! quote$ Quote2$="Ý" ! ou peut remplacer Quof$="%" ! dans les "" ' Clr Terr$ ! msg erreur Clr Terrp& ' Ttxt&=12 ! taille texte graph Clr_eb ! clear block (editeur) Col1&=1 Colg&=2 Font&=1 ! Fonte texte Gosub Defl(1) ! deflist sweetel2 Defl$="" ! bloc tempo ' Contrl(0)=38 ! Inquire Current Graphic Text Attributes Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys Font_tail&=Ptsout(1) ! Taille fonte texte Or_tail&=Ptsout(1) ! Taille fonte texte ' Act_tcol&=-1 Act_atext&=-1 Act_col&=-1 Act_def1&=-1 Act_def2&=-1 Act_def3&=-1 ' Mog&=0 ! mode ‚criture Grill|=0 ! pas de grille (1=cadre 2=grillage) ' Gosub Test_rout ! Tester pr‚sence des routines ' Lp_px&=-1 ! pas de defloupe ' ' D‚finir chemin Set_path$=Space$(2048) ~Gemdos(71,L:V:Set_path$,Gemdos(25)+1) Set_path$=Left$(Set_path$,Instr(Set_path$,Chr$(0))-1)+"\" If Instr(Set_path$,":\")=0 Set_path$=Chr$(65+Gemdos(25))+":"+Set_path$ Endif ' Dim Parx$(4) Gosub Ld.cnf ! charger cnf ' ' ' ' -------------------- ' ..8 fenˆtres. Nombre_w&=9 Wdial&=7 ! id fenetre dial Wd_id&=0 ! id dialogue Wd_incy&=0 ! inr‚mentation Y Wd_set!=True ' -------------------- ' Gosub Start Erase Parx$() ' -------------------- Return ' ' -Princ- G‚n‚ral Procedure Princ Local Boucl&,Evnmnt&,A& ' ' Le bloc suivant prend les 90% du temps de l'initialisation .. ' L'initialisation doit se faire sous couvert de wind_update Set_system&=1 ! on redessine rien du tout!... Gosub Deftext(Col1&,0) Gosub Defmouse(2) ' ~Objc_draw(Adr%(0),0,255,Rx&(0),Ry&(0),Rw&(0),Rh&(0)) Gosub Fmshow("Ouverture de "+Name$) ~@Wind_update01(1) If Gdos? Set_font(Font&) Get_csize Endif Dims&=Max(200,Min(Dims&,Fre(0)\40)) Gosub Inistr ! looong init ~@Wind_update01(0) ~Form_dial(3,0,0,0,0,Rx&(0),Ry&(0),Rw&(0),Rh&(0)) Gosub Fmhide ' @Wmove(Ccsizex&+((W_desk&+1)\2),Ccsizey&+((H_desk&+1)\2),0,0,((W_desk&+1)\2),((H_desk&+1)\2),Ccsizex&*2,Ccsizey&*2) Wset_max_h(3,(Toti&+4)*Ccsizey&) ! nb max d'instr ' ..et fenˆtres! ' ' If Not accessoire! ' Multitƒche implique que effdesk soit activ‚ If Efdesk! ~@Wind_open(Nombre_w&-1) ! Info desk Endif ' Endif ' ~@Wind_create(1) ! #1 doit ˆtre cr‚‚ … tout prix (menu) ' ~@Wind_open(1) ! #1 doit ˆtre cr‚‚ … tout prix (menu) ' Gosub Smaller(1,false) ' ' If boucl&=-1 ! a pu etre cr‚e? ' If Whandle&(1)=>0 ! Menu a pu etre cr‚e? ' ..Desiner fenˆtres cr‚‚es Page_manage(0) ' Bndary(0) Gosub Deffillcol(0) Lhidem ' For boucl&=Nombre_w&-1 Downto 0 If Len(Lcomm$)=0 For Boucl&=5 Downto 0 If Boucl&<>1 ~@Wind_open(Boucl&) Gosub Smaller(Boucl&,False) Gosub W_rdexe Endif Next Boucl& Else ' ~@Wind_open(1) ! cr‚er … tt prix ' Gosub Smaller(1,fase) For Boucl&=5 Downto 0 ' If boucl&<>1 If Whandle&(Boucl&)=>0 ' ~@Wind_open(boucl&) If Not Word(Cvi(Mid$(Lcomm$,Boucl&*36+1+34,2)))=True ! smaller!! Gosub Smaller(Boucl&,False) Else ~@Wind_open(Boucl&) Endif Gosub W_rdexe Endif ' Endif Next Boucl& Endif If Wopen!(1) Top(1) Endif ' Set_system&=0 ! systŠme ok For A&=0 To Nbr_idxw& If @Tstwork(A&) Rdw_all(A&) Endif Next A& ' Gosub Deffillcol(Colg&) @Lshowm Gosub Deffillcol(Colg&) ' ' cr‚er caractŠres vdt Gosub Mloadfnt ' ' Page_manage(0) : init! @Page_set Wsetsl(0) ' Clr File$ File$=Param_prg$ If Len(File$)>0 $S% Select Right$(File$,4) Case ".SWT" File$(0)=File$ @Load.swt Case ".LSW" File$(3)=File$ @Insert.lsw Case ".EGR" File$(1)=File$ @Load.egr Case ".VDT",".VID",".MIN" File$(2)=File$ @Load.vdt Case ".PI3",".DOO",".NEO",".SD3" File$(5)=File$ @Load.bit(0) Case ".SFD" File$(4)=File$ @Load.sfd(0) ' Default ' @Load.swt Endselect $S& Endif Clr Param_prg$ File$=Nom_prg$ If Instr(File$,"\")<>0 File$=Left$(File$,Rinstr(File$,"\")) Endif ' ' ..Boucle principale @Videkbd Set_end!=False ! Boucler Lastw&=-1 Do ' ' Evnmnt&=Evnt_multi(&X110011,1,1,1,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),1000,Mx%,My%,Mk&,Dummy&,Key&,Dummy&) Ha&=@Firstw If Coord! And Ha&=2 ! Loupe dans ed. graph?, loupe! Evnmnt&=Evnt_multi(&X110011,256,3,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),100,Mx%,My%,Mk&,Dummy&,Key&,Clic&) Else if Ha&=4 ! Emul!, cursor If Lastsend|=0 Evnmnt&=Evnt_multi(&X110011,256+$ And And And And Eqv And ,3,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),200,Mx%,My%,Mk&,Dummy&,Key&,Clic&) Else Dec Lastsend| Evnmnt&=Evnt_multi(&X110011,256+3,3,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),25,Mx%,My%,Mk&,Dummy&,Key&,Clic&) Endif Else if Ha&=6 ! DRCS image, arrow Evnmnt&=Evnt_multi(&X110011,256,3,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),10,Mx%,My%,Mk&,Dummy&,Key&,Clic&) Else if Ha&=0 Or Ha&=3 ! Edit, clicS Evnmnt&=Evnt_multi(&X110011,$ And And And And Eqv *+3,3,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),1000,Mx%,My%,Mk&,Dummy&,Key&,Clic&) ' Else ! normal! Evnmnt&=Evnt_multi(&X110011,256+3,3,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),1000,Mx%,My%,Mk&,Dummy&,Key&,Clic&) Endif ' ' ' ' Y a -t- il eu un evnt-mesag? (a traiter en 1er) If Btst(Evnmnt&,4) ! Evnt Menu AES ' ' Cet appel demande de g‚rer tout fullers,closers,sliders,etc etc!!! Reponse%=@Wmanage(True) ! 8ø True: tout g‚rer ' cha ch‚ bien! ' ' If Reponse%=-1 ! Fermeture forc‚e ? Set_end!=True If Help! ! mode 'd‚butant' ? ' If @Wind_update01(True)=0 ! on peut afficher? A&=-1 Gosub Help(0,A&) Clr A& ' Endif Endif ' Endif Endif ! de If end!<>TRUE ' ' Gestion messages: Flags,Id,Key,MouseXYK/Clic If Not Set_end! Gosub Msg_bra(Evnmnt&,Reponse%,Key&,Mx%,My%,Mk&,Clic&) Endif ' ' ' Exit if Set_end! Loop until Set_end! ' Gosub Defmouse(2) Gosub Rq_time(True) ! effacer msg? Gosub Defmouse(2) ' Erase Blt$() Gosub Defmouse(2) ' Clr Vid$ ' ..Fermer tout ce qui reste Wmove(0,0,W_desk&,H_desk&,W_desk&\2,H_desk&\2,1,1) Set_system&=2 ! No Redraw! For Boucl&=0 To Nbr_idxw& ' hideclose=close sans graf_XXXX ~@Wind_hideclose(Boucl&) ! 9ø Gosub W_rdexe Gosub Defmouse(2) Next Boucl& Gosub Defmouse(2) ' Else ' ~@Wind_update01(0) ' ~@Form_alert(1,"[1][|"+"Plus de fenˆtres disponibles! |][ Annuler ]") ' ' Endif ! fin de loop_>0 ' ' ..Et d‚truire tout ce qui reste. For Boucl&=0 To Nbr_idxw& ~@Wind_delete(Boucl&) ! 10ø Next Boucl& ' ' ' Le m‚nage doit se faire sous couvert de wind_update .. ' ~Objc_draw(Adr%(0),0,255,Rx&(0),Ry&(0),Rw&(0),Rh&(0)) Gosub Fmshow("Fermeture de "+Name$) Gosub Defmouse(2) ~@Wind_update01(1) Gosub Uninistr Gosub Defmouse(2) ~@Wind_update01(0) ~Fre(0) Gosub Defmouse(2) Gosub Defmouse(0) ~Form_dial(3,0,0,0,0,Rx&(0),Ry&(0),Rw&(0),Rh&(0)) Gosub Fmhide ' retour: quitter ou retourner dans la boucle (acc) Return ' ' G‚rer tous les msgs sweetel.. Procedure Msg_bra(Evnmnt&,Reponse%,Key&,Mx&,My&,Mk&,Clic&) Local A&,B&,C&,Ha& Local B% Local T$,A$ ' If Not Set_end! Ha&=@Firstw ! PremiŠre fenˆtre? -1=aucune au 1er plan ' If Ha&=0 If Aix%<>Start_x%(0) Or Aiy%<>Start_y%(0) If Aix%<>-1 And Aiy%<>-1 If Not @Tstshow(Ha&,Dw_x%(Page_id&)+Dwx_&(Page_id&)*Ccsizex&,Dw_y%(Page_id&)) Mpos(W_ix&(0),W_iy&(0)+Ccsizey&) Endif Endif Aix%=Start_x%(0) Aiy%=Start_y%(0) Endif Endif Endif ' ' If Btst(Evnmnt&,4) ! Evnt Menu AES If Reponse%<>0 ! Message inconnu? Select Reponse% ' ' Case &H1016 ! ignorer ' Case &H4700 To &H47FF ! VA_PROTOCOL Gosub Va_bra(Reponse%) ' Case 10 ! notre menu!! ' Clr B& ' If Menu_adr%<>0 ! menu bien install‚?? ' Le menu est en fait un raccourci-menu!!! ' (messages g‚r‚s comme le clavier) ' Void Menu_tnormal(Menu_adr%,Wmenu&(3),1) ' ' ' If Ha&=-1 ' ~@Wind_open(1) ' Endif ' A&=Wmenu&(4) ! no objet du menu selectionn‚ ' Sub a&,22 ! a=nø id de l'entr‚e ' ' ' ' Key&=eq_menu&(a&) ! Raccourci-clavier Key&=@Equ_menu(A&) ! equivalent-menu! ' If a&>0 ' Key&=eq_menu&(a&) ! Raccourci-clavier ' Endif ' If Key&<>0 If Key&<0 ! key active dans MENU? Evnmnt&=Word(&X1000000000000001) ! ‚v‚nnement clavier d‚clar‚ ' Else if Key&>31000 ! key active dans Bitmap? Gosub Top(6) ! NewTop If @Wtestop(6) Evnmnt&=Word(&X1000000000000001) ! ‚v‚nnement clavier d‚clar‚ Key&=Key&-31000 ! r‚tablir Endif ' Else if Key&>30000 ! key active dans DRCS? If Key&<>30888 Gosub Top(5) ! NewTop If @Wtestop(5) Evnmnt&=Word(&X1000000000000001) ! ‚v‚nnement clavier d‚clar‚ Key&=Key&-30000 ! r‚tablir Endif Else If Not @Wtestop(6) Gosub Top(5) ! NewTop Endif If @Wtestop(5) Or @Wtestop(6) Evnmnt&=Word(&X1000000000000001) ! ‚v‚nnement clavier d‚clar‚ Key&=Key&-30000 ! r‚tablir Endif Endif Else if Key&>20000 ! key active dans emul? Gosub Top(4) ! NewTop If @Wtestop(4) Evnmnt&=Word(&X1000000000000001) ! ‚v‚nnement clavier d‚clar‚ Key&=Key&-20000 ! r‚tablir Endif Else if Key&>10000 ! key active dans graph? Gosub Top(2) ! NewTop If @Wtestop(2) Evnmnt&=Word(&X1000000000000001) ! ‚v‚nnement clavier d‚clar‚ Key&=Key&-10000 ! r‚tablir Endif Else if Key&>1000 ! key active dans edit? Gosub Top(0) ! NewTop If @Wtestop(0) Evnmnt&=Word(&X1000000000000001) ! ‚v‚nnement clavier d‚clar‚ Key&=Key&-1000 ! r‚tablir Endif ' Else ' rien! Evnmnt&=Word(&X1000000000000001) ! ‚v‚nnement clavier d‚clar‚ Endif Endif ' Endif ! menu install‚ ' Case 30,31,32,33 ' Fenˆtre a perdu le 1er plan? Qui sait... ' Default ' @Beep Gosub Menu.info("Window exept #"+Str$(Reponse%)) ' ~@Infow(0,"! Erreur interne #"+Str$(Reponse%)) Endselect ' Else If Wmenu&(0)=Wm_topped& If Wmenu&(3)=Whandle&(Nbr_idxw&) While Mousek<>0 Wend @Pop_x Endif Endif Endif ' Endif ! fin de if evnt-mesag ' ' ' On mets ici un test permattant de quitter imm‚diatement la boucle au ' cas ou Set_end!=True, c'est … dire que toute les fenˆtres ont ‚t‚s ferm‚es! If Set_end!<>True ' Rq_time(0) ! effacer message (s) ? ' ' (2e:) Ha&=@Firstw ! PremiŠre fenˆtre? -1=aucune au 1er plan If Ha&<0 Ha&=1 Endif ' ' On continue! ' ' ' ' Y a -t- il eu un evnt-clavier? If Btst(Evnmnt&,0) ! Evnt Clavier ' ' Ha&=@Firstw ! PremiŠre fenˆtre? -1=aucune au 1er plan ' ! C'est cette fenˆtre qui est concern‚e par ' ! un evnt-clavier ou souris (s'il y a lieu) ' ' ' Oui, alors on cherche … d‚coder le carectŠre renvoy‚ ' par evnt-multi: If Btst(Evnmnt&,15)=0 ! Non simul‚ Key&=@Geminp(Key&) ! D‚coder 2 octets->1 octet Endif ' ' Shf d+g = vide If @Shiftbrk Gosub Defmouse(2) While @Shiftbrk @Videkbd Wend Gosub Defmouse(0) Endif ' ' Manager: ^N:changer de fenˆtres etc.. (facultatif) ' Vous pouvez modifier la fonction Wkmanage a vos besoins ' personnels ' If Not @Wkmanage(Key&) ! Non trait‚ par le manager? If Ha&=>0 ! Une de nos fenˆtre est au premier plan? ' ' If Key&=226 If Ha&=4 Key&=2260 Endif Endif ' $S& Select Key& ' Case 226 If Ha&=0 ! ed Page_manage(-2) ' Else If Not Wopen!(3) ~@Wind_open(3) Endif If Not Wopen!(3) ~@Form_alert(1,"[3][|"+"Il n'y a plus de fenˆtres |disponibles sur le bureau! |Fermez en une inutilis‚e. |][Confirmer]") Endif Help!=Not Help! If Help! ' ~@Form_alert(1,"[1][|Aide activ‚e. ][ Confirmer ]") A&=-226 Gosub Help(0,A&) ' ~@Form_alert(1,"[1][|Lisez aussi SWEETEL.DOC ! ][ Vi ]") Clr A& Else ~@Form_alert(1,"[1][|Aide d‚sactiv‚e. ][Confirmer]") Endif ' Endif ' Case 4 ~@Wind_open(0) If Wopen!(0) @Top(0) Else ~@Form_alert(1,"[3][|"+"Il n'y a plus de fenˆtres |disponibles sur le bureau! |Fermez en une inutilis‚e. |][Confirmer]") Endif Case 7 ~@Wind_open(2) If Wopen!(2) @Top(2) Else ~@Form_alert(1,"[3][|"+"Il n'y a plus de fenˆtres |disponibles sur le bureau! |Fermez en une inutilis‚e. |][Confirmer]") Endif Case 24 ! ^x menu ~@Wind_open(1) If Wopen!(1) @Top(1) Else ~@Form_alert(1,"[3][|"+"Il n'y a plus de fenˆtres |disponibles sur le bureau! |Fermez en une inutilis‚e. |][Confirmer]") Endif Case 15 ~@Wind_open(3) If Wopen!(3) @Top(3) Else ~@Form_alert(1,"[3][|"+"Il n'y a plus de fenˆtres |disponibles sur le bureau! |Fermez en une inutilis‚e. |][Confirmer]") Endif Case 20 ~@Wind_open(4) If Wopen!(4) @Top(4) Ha&=@Firstw If Ha&=4 Gosub Add_menu(Ha&) Lastw&=4 Endif Else ~@Form_alert(1,"[3][|"+"Il n'y a plus de fenˆtres |disponibles sur le bureau! |Fermez en une inutilis‚e. |][Confirmer]") Endif Case 18,278 If And(@Bios11,&X11)=0 And Key&<>278 ~@Wind_open(5) If Wopen!(5) @Top(5) Else ~@Form_alert(1,"[3][|"+"Il n'y a plus de fenˆtres |disponibles sur le bureau! |Fermez en une inutilis‚e. |][Confirmer]") Endif Else ~@Wind_open(6) If Wopen!(6) @Top(6) If Bitmap%<=0 @Load.bit(0) Endif Else ~@Form_alert(1,"[3][|"+"Il n'y a plus de fenˆtres |disponibles sur le bureau! |Fermez en une inutilis‚e. |][Confirmer]") Endif Endif ' Case 23 For A&=0 To Nombre_w&-2-1 ~@Wind_open(A&) @W_rdexe Next A& Gosub Menu.info("Fenˆtres d‚ploy‚es") ' Case -300 To -1 ! simul‚ menu Key&=-Key& @Selectmnu(Key&) ' Default ' Il faut d‚terminer … qui le caractŠre a ‚t‚ envoy‚: ' Select Ha& ! CaractŠre pour quelle fenˆtre? ' Case 0 If Ha&=0 If @Selectk(Key&)=0 Select Key& Case 23 ~@Wind_open(0) ~@Wind_open(1) ~@Wind_open(2) ~@Wind_open(3) ~@Wind_open(4) ' Case "8","2","6","4" ! 8/2/6/4 ou flŠches ? ' If Btst(@Shift,1)=0 ! chiffre Page_manage(Key&) ' Else ! flŠche ' Select Key& Case "8","2" A&=Start_y%(0) ! Ajout en Y Default A&=Start_x%(0) Endselect ' Select Key& Case "8","4" ! shft up Dec A& Case "2","6" ! shft dwn Inc A& Endselect ' Select Key& Case "8","2" Gosub V_dec(Ha&,A&) ' a&=@W_vslnorm(0,a&) ! V‚rifier l'intervalle Verticale ' If Start_y%(0)<>a& ! Modifi‚e? ' Start_y%(0)=a& ! Alors ‚crire nouveau W_Ay ' Wsetsl(0) ! Modifier sliders ' Gosub Drawx(0) ' Gosub Fdnotice(0,W_ix&(0),W_iy&(0),W_iw&(0),W_ih&(0)) Gosub Fdtest ' Endif ' Default Gosub H_dec(Ha&,A&) ' a&=@W_hslnorm(0,a&) ! V‚rifier l'intervalle Horizontal ' If Start_X%(0)<>a& ! Modifi‚e? ' Start_X%(0)=a& ! Alors ‚crire nouveau W_Ax ' Wsetsl(0) ! Modifier sliders ' Gosub Drawx(0) ' Gosub Fdnotice(0,W_ix&(0),W_iy&(0),W_iw&(0),W_ih&(0)) Gosub Fdtest ' Endif Endselect @Videkbd Endif ! de if 8,2,4,6 (flŠches) ' Default Page_manage(Key&) Endselect ' Endif Endif ' Case 2 ' If @Selectk(Key&)=0 @Selectgrf(Key&) Endif ' Case 4 ! ‚mul ' Select Key& Case 191 ~@Selectk(Key&) Default If Emul! If @Emulek(Key&,Btst(Evnmnt&,15))=0 ~@Selectk(Key&) Endif ' Else If Btst(Evnmnt&,15)=0 ! Non simul‚ If @Selectk(Key&)=0 Minikey(Key&) Endif ' Else ! menu! If @Emulek(Key&,-1)=0 ~@Selectk(Key&) Endif Endif ' Endif Endselect ' Case 5 ! DRCS ' If @Selectk(Key&)=0 @Selectdrcs(Key&) Endif ' Case 6 ! bitmap If @Selectk(Key&)=0 @Bitkey(Key&) Endif ' Case 3 ! liste ' ' If @Selectk(Key&)=0 Key&=@Upcase(Key&) If Not Hl! Select Key& Case "A" To "Z" A&=0 Do If Lst&(A&)=>0 If Left$(Instr$(Lst&(A&),0))=Chr$(Key&) Dec A& Mul A&,Ccsizey& Start_y%(3)=A& ! Alors ‚crire nouveau W_Ay Wsetsl(3) ! Modifier sliders Gosub Drawx(3) ' ~Form_dial(3,0,0,0,0,W_ix&(3),W_iy&(3),W_iw&(3),W_ih&(3)) Rdw_all(3) A&=-1 Endif Endif ' Inc A& If A&>Istr&+Nxmenu&+2 @Beep A&=0 Endif Loop until A&=0 @Videkbd ' Case 200,208,56,50 ' A&=Start_y%(Ha&) ! Ajout en Y Select Key& Case 200 ! Line Up If Btst(@Shift,2) Sub A&,W_ih&(Ha&) Else Sub A&,Ccsizey& Endif ' Case 208 ! Line Down If Btst(@Shift,2) Add A&,W_ih&(Ha&) Else Add A&,Ccsizey& Endif ' Case 56 ! shft up Dec A& ' Case 50 ! shft dwn Inc A& ' Endselect ' ' a&=@W_vslnorm(3,a&) ! V‚rifier l'intervalle Verticale ' If Start_y%(3)<>a& ! Modifi‚e? ' Start_y%(3)=a& ! Alors ‚crire nouveau W_Ay ' Wsetsl(3) ! Modifier sliders ' Gosub Drawx(3) ' Gosub Fdnotice(3,W_ix&(3),W_iy&(3),W_iw&(3),W_ih&(3)) ' Endif Gosub V_dec(Ha&,A&) Gosub Fdtest @Videkbd ' Endselect Else Select Key& Case 27,3 @Hlp_stat(False,0) Case 225 ! undo @Inundo Endselect ' Endif Endif ' Default ! case 1 ; menu ou autre ' Case 1 ! Touche dans Menu? ' If @Selectk(Key&)=0 @Selectmnu(Key&) Endif ' ' Endselect ! de ha& ' Endselect ! 1er key& ' Endif ! de If WKmanage ' Endif ! de ha&<>-1 ' Endif ! de evnt-clavier $S% ' ' If Menu_adr%>0 Ha&=@Firstw ! PremiŠre fenˆtre? -1=aucune au 1er plan ' Y a -t- il eu un changement de fenˆtre? ' If Reponse%<>-1 If Ha&<0 Ha&=1 ! menu menu Endif If Lastw&<>Ha& If Not @Menu_oqp ! menu non oqp? (select) Lastw&=Ha& Gosub Add_menu(Ha&) If Ha&=4 Rdw_all(4) Endif Endif Endif Endif Endif ' ' ' Exit if Set_end! ' ' ' Y a -t- il eu un evnt-souris? If Btst(Evnmnt&,1) ! Evnt SOURIS ' ' Routine qui tente de d‚meler cette ---- de gem If Mk&=0 ! 1 ou 2 (pas de diff‚rence) Mk&=@Xmousek ! c'est vraiment un clic 0? ' Else if Mk&=1 $S& Select @Xmousek Case 0 Mk&=1 Default Mk&=@Xmousek Endselect $S% Endif ' If Ha&=>0 ' If @Wavisible(Ha&,Mx&,My&) ! Coord visible? ' If Mk&<>0 ! Mouse? ' If Ha&=>0 $S& Select Ha& ' Case 0 ! Dans editeur ' If Clic&=1 If Mk&=1 Gosub Mpos(Mx&,My&) Else if Mk&=2 Endif Else if Clic&=2 Gosub Moused(Mx&,My&) Endif ' Case 2 ' Select Mk& Case 2,3 Gosub G_menu Default Gosub Mdrw(Mx&,My&,Mk&) Endselect ' Case 4 ! clic gauche If Clic&=1 If Mk&=1 And ((Mx&<@Wxacoord(4,Emx&+2) And Mx&>@Wxacoord(4,Emx&-6)) Or (My&<@Wyacoord(4,Emy&+2) And My&>@Wyacoord(4,Emy&-6))) Gosub Defmouse(4) ~Graf_dragbox((Vmax_x&+1)*Eccsizex&,(Vmax_y&+1)*Eccsizey&,@Wxacoord(4,Emx&),@Wyacoord(4,Emy&),@Wxacoord(4,0),@Wyacoord(4,0),@âÝ€€ÿf4,W_desk&-1),@Wyacoord(4,H_desk&-1),Mx&,My&) Gosub Defmouse(0) Mx&=Max(0,@Wxrcoord(4,Mx&)) My&=Max(0,@Wyrcoord(4,My&)) If Emx&<>Mx& Or Emy&<>My& Emx&=Mx& Emy&=My& Gosub Field_max Gosub Wsetsl(4) Rdw_all(4) Endif ' Else ' If Emul! Select Mk& Case 1 Gosub Emclip(Mx&,My&) Case 2 ~@Emulek(161,0) Case 3 ~@Emulek(174,-1) Endselect Else Select Mk& Case 1 ' Set curs Gosub Miniset(Mx&,My&) Case 2 ' Menu Gosub Minimnu Endselect Endif ' Endif ' Else if Clic&=2 ! 2 clics ' Gosub Emclic(Mx&,My&,Mk&) Endif ' Case 5 If Mk&=1 And ((Mx&<@Wxacoord(5,Drs_x&+2) And Mx&>@Wxacoord(5,Drs_x&-6)) Or (My&<@Wyacoord(5,Drs_y&+2) And My&>@Wyacoord(5,Drs_y&-6))) Gosub Defmouse(4) ~Graf_dragbox(47*12,$ And And And And Eqv Or *14,@Wxacoord(5,Drs_x&),@Wyacoord(5,Drs_y&),@Wxacoord(5,0),@Wyacoord(5,0),@Wxacoord(5,W_desk&-1),@Wyacoord(5,H_desk&-1),Mx&,My&) Gosub Defmouse(0) Mx&=Max(0,@Wxrcoord(5,Mx&)) My&=Max(0,@Wyrcoord(5,My&)) If Drs_x&<>Mx& Or Drs_y&<>My& Drs_x&=Mx& Drs_y&=My& Gosub Field_max Gosub Wsetsl(5) Rdw_all(5) Endif Else Select Mk& Case 1 Gosub Drcs_sel(Mx&,My&) Case 2 Gosub Drcs_char(Mx&,My&) Endselect Endif ' Case 6 ! Mono DRCS If Mk&=1 @Pixsel(Mx&,My&) Else Gosub Defmouse(0) @Pixdefs Endif ' Case 1 ! Menu If @Firstw=>0 If Mk&=1 ! macro ' ' @Macro ' Else ! opts @Selectmnu(Asc("O")) Endif Endif ' Case 3 ! LISTE AIDE ' If Mk&=1 And Clic&=2 ' ~@Wind_update01(1) Wind_clip(3) ! clipper fenˆtre 3 @Hidem Do ~@Graf_mkstate(Mx&,My&,Mk&,A&) ' If Mx&>W_ix&(3)+W_iw&(3) Or Mx&W_iy&(3)+W_ih&(3) Or My&-1 My&=(@Wyrcoord(3,My&))\Ccsizey& My&=Min(Max(My&,0),Toti&+1) ' If Not Hl! If My&-1 @Lhidem Graphmode (3) Wind_clip(3) ! clipper fenˆtre 3 Gosub Pbox(@Wxacoord(3,0),@Wyacoord(3,My&*Ccsizey&+2),@Wxacoord(3,W_iw&(3)),@Wyacoord(3,My&*Ccsizey&+Ccsizey&)) @Lshowm A&=Lst&(My&+1) ' T$=@Linehelp$(a&) ! ligne d'aide ' ~@Infow(3,T$) @Lhidem Gosub Pbox(@Wxacoord(3,0),@Wyacoord(3,My&*Ccsizey&+2),@Wxacoord(3,W_iw&(3)),@Wyacoord(3,My&*Ccsizey&+Ccsizey&)) Graphmode (1) Clip_off @Lshowm ' @Hlp_stat(True,A&) Else ' a&=0 Xpoint(Mx&,@Wyacoord(3,My&*Ccsizey&)) ' Graphmode 3 Endif Endif ' Else ' ~@Graf_mkstate(Mx&,My&,Mk&,A&) Mx&=@Wxrcoord(3,Mx&) My&=@Wyrcoord(3,My&) Mx&=Mx&\Ccsizex& My&=My&\Ccsizey& If My&>2 And My&<80 If Len(Pageh$(My&))>0 Clr A$ A&=1 B&=Len(Pageh$(My&)) Do $S& Select Mid$(Pageh$(My&),A&,1) Case "œ" Select Mid$(Pageh$(My&),A&+1,1) Case " " ! faux espace A$=A$+"~" Inc A& Default Inc A& Endselect Default A$=A$+Mid$(Pageh$(My&),A&,1) Endselect $S% Inc A& Loop until A&>B& If (Mid$(A$,Mx&,1)<>" ") And (Mx&<=B&) ' A$=Upper$(A$) A&=Mx& Do $S& Select Mid$(A$,A&,1) Case "A" To "Z","0" To "9",":","}","{","\","'","*","$","","~" Case "œ" Select Mid$(A$,A&+1,1) Case " " ! faux espace Default Dec A& Exit if True Endselect Default Exit if True Endselect $S% Dec A& Loop until A&<=0 Inc A& ' A&=Max(1,Rinstr(A$," ",Mx&)) ' ' A&=Max(1,Rinstr(A$," ",Mx&)) ' C&=Rinstr(A$,"(",Mx&) ' If C&>0 ' A&=Max(A&,C&) ' Endif ' B&=Mx& Do $S& Select Mid$(A$,B&,1) Case "A" To "Z","0" To "9",":","}","{","\","'","*","$","","~" Case "œ" Select Mid$(A$,B&+1,1) Case " " Default Exit if True Endselect Case "(" Inc B& Exit if True Default Exit if True Endselect $S% Inc B& Loop until B&>Len(A$) Dec B& ' B&=Instr(A$," ",Mx&) ' C&=Instr(A$,")",Mx&) ' If C&>0 ' B&=Min(B&,C&) ' Endif ' If B&=0 ' B&=Len(A$) ' Endif If B&-A&+1>0 A$=Trim$(Upper$(Mid$(A$,A&,B&-A&+1))) If Len(A$)>0 Clr T$ For A&=1 To Len(A$) ' $S& Select Mid$(A$,A&,1) ' pas de ?? = (?) Case "A" To "Z","0" To "9",":","}","{","\","'","*","$","~" T$=T$+Mid$(A$,A&,1) Case "" ! proc‚dure T$=T$+"E" ' ' Garder () (fonctions) Case "(" If Len(T$)>0 T$=T$+"()" Exit if True ! all, folks! Endif Case "'" ! externe T$=T$+"'" Case "œ" Select Mid$(A$,A&+1,1) Case " " ! faux espace T$=T$+"~" Default If Len(T$)>0 Exit if True Else Inc A& Endif Endselect Endselect $S% Next A& ' If Pageh$(0)<>T$ If T$="*MENU" Hlp_stat(False,0) Else if T$="*REVENIR" @Inundo Else ' If A&<=Maxi& ! trouv‚! A&=@Hindex(T$) ! ID index? If A&<>-1 ! trouv‚! Hlp_stat(True,A&) Else Gosub Defmouse(2) ~Evnt_timer(50) Gosub Defmouse(0) Endif Endif Else @Beep Endif Endif Endif Endif Endif Endif Clr A$,T$ ' @Hlp_stat(False,0) ' Endif ' While Mousek<>0 Wend @Caremouse ' Endif ' Loop until Mk&<>1 @Showm ' ~@Wind_update01(0) Gosub Defmouse(0) ' Endif ! de mk=1 Graphmode (1) ' Case Nbr_idxw& If Mk&>0 @Pop_x ! popup! Endif ' Endselect ! fin de select ha& $S% ' Endif ! fin de Test Mk ' Endif ! fin de if Tst ha&<>-1 ' Endif ! fin de if mk<>0 ' Endif ! fin de if ha&=>0 ' Endif ! Fin de if evnt-souris ' ' Y a -t- il eu un evnt-timer? If Btst(Evnmnt&,5) ! Evnt Timer ' @Test_menu ' If Coord! And Ha&=2 ! Loupe dans ed. graph? ' Fenˆtre visible? If Mx&=>W_ix&(2) And My&=>W_iy&(2) And Mx&<=W_ix&(2)+320 And My&<=W_iy&(2)+150 If Not @Menu_oqp Gosub Coord(Mx&,My&) Endif ' Else If Lp_draw!=True ! la loupe est affich‚e If Not @Menu_oqp Rd_all(2,W_ix&(2)+324,W_iy&(2),W_iw&(2),W_ih&(2)) Rd_all(2,W_ix&(2),W_iy&(2)+154,W_iw&(2),W_ih&(2)) Endif Endif Endif Else If Lp_draw!=True ! la loupe est affich‚e If Not @Menu_oqp Rd_all(2,W_ix&(2)+324,W_iy&(2),W_iw&(2),W_ih&(2)) Rd_all(2,W_ix&(2),W_iy&(2)+154,W_iw&(2),W_ih&(2)) Endif Endif Endif ' If Ha&=6 If Not @Menu_oqp If Bclr(@Bios11,5)<>0 Mx&=@Wxrcoord(6,Mx&) My&=@Wyrcoord(6,My&) If Mod(Mx&,8)<>0 Mx&=(Mx&\8)*8 Endif If Mod(My&,8)<>0 My&=(My&\10)*10 Endif Mx&=@Wxacoord(6,Mx&) My&=@Wyacoord(6,My&) Endif Gosub Picline(Mx&,My&) ! viseur!.. Endif Endif ' If Restore_l0!=True Restore_l0!=False Drawx(0) Endif If Restore_4! Restore_4!=False Gosub Drawx(4) ! barre infos Endif If Menu_time! B%=Gemdos(44) If B%<>Lastime% ~@Infow(1,"Il est "+Time$+" le "+Date$) Lastime%=B% Endif Endif ' If @Gfirstw ! on a le droit If Capt|>0 Gosub Drawx(1) Endif ' If @Tstwork(4) ! ‚mul fonctionnel? Gosub Flash ! periodique, flashing et curseur ' ! ainsi que l'‚mulation et capture! Else @Tmanage(False) ! juste capture & ‚mul.. (si besoin!) Endif Else If Capt|>0 ~@Infow(1,"Capture interrompue (application ou accessoire ‚tranger)") Endif Endif ' Mettre ici les taches qui doivent etre execut‚es ' periodiquement (par ex: horloge, impression, etc.. ) ' La periode d‚pend de l'evnt_count de evnt_timer() ' Endif ! Fin evnt-timer ' ' ' Ha&=@Xfirstw ! Fenˆtre actuelle? -1=aucune au 1er plan ' If Not accessoire! If Multi! If Ha&<0 ! On a plus de fenˆtres en 1e plan If Wopen!(Nombre_w&-1) ~@Wind_hideclose(Nombre_w&-1) Gosub W_rdexe Endif Else If Efdesk! If Not Wopen!(Nombre_w&-1) ~@Wind_open(Nombre_w&-1) For A&=Nbr_idxw&-1 Downto 0 If Wopen!(A&) Gosub Xtop(A&) ! NewTop Gosub W_rdexe Endif Next A& Gosub Top(1) Endif Endif Endif Endif Endif ! fin test 1e plan ' Endif ' ' Return ' Procedure Hlp_stat(Flag!,A&) Local B% Local A! Local T$ ' If Not Flag! If Hl! Graphmode (1) Hl!=False Wset_max_h(3,(Toti&+4)*Ccsizey&) ! nb max d'instr Start_y%(3)=Hl_y% Start_x%(3)=0 @Wsetsl(3) Rdw_all(3) Endif Inab$="" ! historique Inabs$="" ! slide historique Else If A&=>0 T$=@Linehelp$(A&) ! ligne d'aide Else if A&<-1 T$=Chr$(3)+" "+@Xlst$(A&) ! ligne d'aide Else if A&=-1000 T$=Hstat$ Endif ~@Infow(3,T$+" (aide compl‚mentaire..)") A!=False ' If Not (Pageh$(0)=instr$(A&,0)) If Not (Pageh$(0)=@ÄŸî#É f (ÚÐhf ð #è fð f$f,@wßÈ!uè!ÐgÈ$A&)) ' Restore Instrh If Not @Fexist(Ina$) @Showm Ina$=@Fsel$("\SWEETEL2.INA",Ina$,"Fichier aide Sweetel2?") Endif If @Exist(Ina$) @Defmouse(2) Open "I",#1,Ina$ Clr B% Do Line input #1,A$ ' If A$=instr$(A&,0) If A$=@Xlst$(A&) B%=Cvl(Input$(4,#1)) Else if A$="END}" B%=-1 Else ~Inp%(#1) Endif Loop until Eof(#1) Or B%<>0 ' If B%>0 Seek #1,0 Seek #1,B% ! position ' If Hl! If Len(Inab$)<800 Inab$=Inab$+Chr$(0)+Pageh$(0) ! historique Inabs$=Inabs$+Mki$(Start_y%(3)) ! historique Endif Start_x%(3)=0 Start_y%(3)=0 Else If Len(Inab$)=0 Hl_y%=Start_y%(3) Start_x%(3)=0 Start_y%(3)=0 Endif Endif ' For B%=0 To 80 Pageh$(B%)="" Next B% Hl!=True A!=True Clr B% ' Pageh$(0)=instr$(A&,0) ! uniquement pour ID Pageh$(0)=@Xlst$(A&) ! uniquement pour ID Pageh$(1)="œ_Notes concernant œG"+@Xlst$(A&)+"œ_:" Pageh$(3)=T$ B%=5 Do ' Read A$ ' A$=@Aread$ Line input #1,A$ If A$<>"END}" Pageh$(B%)=A$ Inc B% Exit if B%=>75 Endif Loop until (A$="END}") Or Eof(#1) Inc B% Pageh$(B%)="(Retour au œ_*MENUœ-)" If Len(Inab$)>0 And Len(Inabs$)>0 Inc B% Pageh$(B%)="( œ_*REVENIRœ- … instruction pr‚c‚dente)" Endif Inc B% Pageh$(B%)="œ*" ! marque de fin Endif Close #1 @Defmouse(0) Clr A$ Endif ' Else If Not Hl! If Len(Inab$)=0 Hl_y%=Start_y%(3) Start_x%(3)=0 Start_y%(3)=0 Endif ' Hl!=True ! d‚ja charg‚e!! A!=True B%=0 While (Pageh$(B%)<>"œ*") And (B%<80) Inc B% Wend Endif ' Endif ~@Infow(3,T$) ' If A! ' Hl_y%=Start_y%(3) ' Start_X%(3)=0 ' Start_y%(3)=0 Wset_max_h(3,(B%+4)*Ccsizey&) ! nb max d'instr @Wsetsl(3) Rdw_all(3) Endif ' Endif Return ' Function Xlst$(A&) If A&=>0 Return Instr$(A&,0) Else if A&=-1000 Return Hstat$ Else if A&<-1 Return Xmenu$(-(A&+2)) Endif Endfunc ' Procedure Inundo Local A&,B&,S& Local T$ ' If Hl! If Len(Inab$)>0 A&=Rinstr(Inab$,Chr$(0)) If A&>0 T$=Right$(Inab$,Len(Inab$)-A&) S&=Cvi(Right$(Inabs$,2)) If Pageh$(0)<>T$ B&=@Hindex(T$) ! ID index? ' ' remarque: si y'en a un qui est vide (inabs$) alors "precedent" n'apparaitera pas (rus‚!) Inabs$=Left$(Inabs$,Len(Inabs$)-2) If B&<>-1 ! trouv‚! Start_y%(3)=S& ! Alors ‚crire nouveau W_Ay ' @Wsetsl(3) Hl!=False Hlp_stat(True,B&) Hl!=True Endif Endif Inab$=Left$(Inab$,A&-1) Else Clr Inab$,Inabs$ Endif Else @Beep Endif Else Clr Inab$,Inabs$ Endif Return ' Function Hindex(T$) $F% Local A& ' If Right$(T$,2)<>"()" If Left$(T$,1)<>"'" And Right$(T$,1)<>"'" A&=0 Do Exit if Instr$(A&,0)=T$ Inc A& Loop until A&>Maxi& If A&>Maxi& A&=-2 Do Exit if @Xlst$(A&)=T$ Dec A& Loop until A&<-Maxex&-2 If A&<-Maxex&-2 A&=-1 Endif Endif Else A&=-1000 ! externe Hstat$=T$ Endif Else A&=-1000 ! externe Hstat$=T$ Endif ' Return A& Endfunc ' ' Function Aread$ ' Local A$ ' Do ' Line input #1,A$ ' Loop until (Eof(#1)) Or (Left$(A$,1)<>";") ' Return A$ ' Endfunc ' ' ' Interne, charger INLs Procedure My_load @Printl(Chr$(27)+"E") My_bin(Swsound%,"JMJ",972) My_bin(M_anim%,"M_ANIM",444) My_bin(R40cl%,"SW,R40CL",28) My_bin(R40st%,"SW,R40ST",32) My_bin(Rlsl%,"SW,RLSL",28) My_bin(Rlsr%,"SW,RLSR",36) My_bin(Rinv%,"SW,RINV",24) My_bin(Rbn%,"SW,RBN",44) My_bin(Tst63%,"SW,TST63",36) My_bin(Wherest%,"SW,WHERE",40) My_bin(Drawline%,"SW,DRAWL",108) My_bin(Hflip%,"SW,HFLIP",44) My_bin(Vflip%,"SW,VFLIP",126) My_bin(Ssright%,"SW,SSRIG",124) My_bin(Ssdown%,"SW,SSDOW",272) My_bin(Cache%,"SW,CACHE",86) My_bin(Teststr%,"SW,TESTS",72) My_bin(Indent%,"SW,INDEN",246) My_bin(Blitc%,"SW,BLTC",176) My_bin(Clrblk%,"CLROPTI",140) My_bin(Swmin%,"SW,DEFLS",174) My_bin(Swchar%,"SW,SWCHR",104) @Printl("Ok") Edit Return Procedure My_bin(A%,E$,L%) ! interne au gfa Local A$ If A%>0 @Printl("LOAD.. D:\PROGRAMM\GFA\SOURCES.GFA\"+E$+".INL") Open "I",#1,"D:\PROGRAMM\GFA\SOURCES.GFA\"+E$+".INL" If L%=Lof(#1) Bget #1,A%,Lof(#1) Else Beep @Printl("ERREUR LEN AVEC "+E$) ~Inp(2) Endif Close #1 Else Beep @Printl("ERREUR ADR AVEC "+E$) ~Inp(2) Endif Return ' ' ..Fermer la fenˆtre #X (champ X) ; sans grow/shrink Function Wind_hideclose(Index&) $F% Local Reponse% ' If Whandle&(Index&)=>0 If Wopen!(Index&) Reponse%=Wind_close(Whandle&(Index&)) Wopen!(Index&)=False If Dim?(Dw_$()) Do_wclr(Index&) Endif Else Reponse%=-1 Endif ~@Wind_delete(Index&) Else Return -1 Endif ' Return Reponse% Endfunc Function Gfirstw $F% Local A&,Y& ' ~Wind_get(Whandle&(0),10,A&,Y&,Y&,Y&) If A&=0 Return -1 ! ch‚ nous! Else Y&=@Windex(A&) If Y&=-1 ! autre fenˆtre!!! (accessoire etc) Return 0 Else Return -1 ! ch‚ nous Endif Endif ' Return 0 Endfunc ' ' Procedure Reloadfnt ! recharger fonte graphique Erase Blt$() Clr Blt_cadr$,Blt_grill$ Gosub Createfnt Gosub Clear_cache ! vider cache video-TEXT Return Procedure Mloadfnt ! cr‚er fonte graphique ' @Getplane ! Nb de plans (@Get/@Put) Gosub Createfnt Return ' g‚nŠre une fonte graphique Procedure Createfnt Local A&,B&,X& Local A$ ! get local ' @Hidem ~@Wind_update01(1) Gosub Defmouse(2) Dim Blt$(63) ! 8 col, 63 caractŠres Edited!(1)=False A&=@Xfirstw If A&<>-1 B&=W_iy&(A&)+1 A&=W_ix&(A&)+1 Else Clr A& Clr B& Endif If A&>Work_out(0)-20 Or B&>Work_out(1)-20 Or (A&*B&)=0 A&=X_desk&+1 B&=Y_desk&+1 Endif Clip Off Gosub Deffill(0,1,1) Bndary(0) Pbox A&-1,B&-1,A&+9+1,B&+7+$ And And And And Imp $ And + Or &O1500000074 Xor As A&+1,B&+1,A&+1,B&+6 ' Line A&+1,B&+1,A&+1,B&+6 Line A&+5,B&+1,A&+5,B&+7 Line A&+1,B&+1,A&+8,B&+1 Line A&+1,B&+3,A&+8,B&+3 Line A&+1,B&+5,A&+8,B&+5 @Get(A&+1,B&+1,A&+8,B&+6,A$) ' GRILLe Blt_grill$=A$ ' Pbox A&,B&,A&+9,B&+7 Box A&+1,B&+1,A&+9,B&+7 @Get(A&+1,B&+1,A&+8,B&+6,A$) ' CADRe Blt_cadr$=A$ ' Pbox A&,B&,A&+9,B&+7 @Get(A&+1,B&+1,A&+8,B&+6,A$) Blt$(0)=A$ For X&=1 To 63 @Put(A&+1,B&+1,Blt$(0)) Gosub Deffillcol(Colg&) If Btst(X&,0) Pbox A&+1,B&+1,A&+4,B&+2 Endif If Btst(X&,1) Pbox A&+5,B&+1,A&+8,B&+2 Endif If Btst(X&,2) Pbox A&+1,B&+3,A&+4,B&+4 Endif If Btst(X&,3) Pbox A&+5,B&+3,A&+8,B&+4 Endif If Btst(X&,4) Pbox A&+1,B&+5,A&+4,B&+6 Endif If Btst(X&,5) Pbox A&+5,B&+5,A&+8,B&+6 Endif @Get(A&+1,B&+1,A&+8,B&+6,A$) Blt$(X&)=A$ Next X& Gosub Deffillcol(Colg&) Gosub Defmouse(0) ~@Wind_update01(0) ~Form_dial(3,0,0,0,0,Max(0,A&-4),Max(0,B&-4),16,16) @Showm ' Return ' Put (avec ou sans grille?) Procedure Putp(X&,Y&,N&) ' @Put(X&,Y&,Blt$(N&)) $S& Select Grill| Case 0 Case 1 Set_putmode&=7 ! or @Put(X&,Y&,Blt_cadr$) Set_putmode&=3 ! replace Case 2 Set_putmode&=7 ! or @Put(X&,Y&,Blt_grill$) Set_putmode&=3 ! replace Endselect $S% Return ' ' zouli Procedure Xpoint(Mx&,My&) ' Local X&,Y& ' $S& Select Random(8) Case 0 Inc My_demo& Case 1 Inc Mx_demo& Case 2 Inc Mx_demo& Inc My_demo& Case 4 Dec My_demo& Case 5 Dec Mx_demo& Case 6 Dec Mx_demo& Dec My_demo& Endselect $S% ' If My_demo&>Ccsizey&*2 Or My_demo&<0 My_demo&=0 Endif If Mx_demo&>Ccsizex&*2 Or Mx_demo&<0 Mx_demo&=0 Endif Graphmode (3) @Lhidem Gosub Line(Mx&,My&+My_demo&,Mx&+Ccsizex&*2,My&+My_demo&) Gosub Line(Mx&+Mx_demo&,My&,Mx&+Mx_demo&,My&+Ccsizey&*2) ~Evnt_timer(50) Gosub Line(Mx&,My&+My_demo&,Mx&+Ccsizex&*2,My&+My_demo&) Gosub Line(Mx&+Mx_demo&,My&,Mx&+Mx_demo&,My&+Ccsizey&*2) @Lshowm Graphmode (1) ' ' X&=Rand(Ccsizex&*2)-Ccsizex&+Mx& ' Y&=Rand(Ccsizey&*2)-Ccsizey&+My& ' Plot X&+2,Y&+2 ' Plot X&+1,Y&+1 ' Plot X&,Y& ' Plot X&+2,Y&+2 ' Plot X&+1,Y&+1 ' Plot X&,Y& Return ' ' occupp‚ Procedure Oqp Local A%,Y% ' Y%=Set_system& Set_system&=1 @Lhidem For A%=0 To Nbr_idxw&-1-1 If @Tstwork(A%) If A%<>4 Or (Not Redir!) Rdw_all(A%) Endif Endif Next A% @Lshowm Set_system&=Y% ' Return Procedure Desoqp Local A% ' @Lhidem For A%=0 To Nbr_idxw&-1-1 If @Tstwork(A%) If A%<>4 Or (Not Redir!) Rdw_all(A%) Endif Endif Next A% @Lshowm @Test_menu Return ' ' placer curs a x,y (souris) Procedure Mpos(Mx%,My%) Local T$ ' If Modify! Page_manage(208) Endif ' Aix%=-1 ! curseur dynamique off (car on es d‚j… pass‚) Aiy%=-1 ' If Not Modify! Mx%=@Wxrcoord(0,Mx%) ! Coord My%=@Wyrcoord(0,My%) ! relatives! Div Mx%,Ccsizex& Div My%,Ccsizey& My%=Max(0,My%) Mx%=Max(1,Mx%) ' ' T$=Page$(Ty&) ' ~@Do_winput(Page_id&,-1,-1,-2,Maxstr&,T$) Wind_clip(0) ! clipper fenˆtre 0 Wdobox(Page_id&,False) Do_wkill(Page_id&) Ty&=Max(0,Min(Maxty&-2,My%)) T$=@Defm$(Ty&) Sub Mx%,Pag_ind&(Ty&) ! - indent Mx%=Max(1,Mx%) Dwx_&(Page_id&)=Min(Max(0,Mx%),Len(T$)+1) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,T$) Clr T$ Restore_l0!=True Endif Return ' ' ' dessine un pt (souris) Procedure Mdrw(Mx&,My&,Mk&) Local X2%,Y2%,A&,B&,C%,Key&,W%,H%,Vididx& ' x=ax h=ay ' If Mx&=>W_ix&(2) And My&=>W_iy&(2) And Mx&<=W_ix&(2)+320 And My&<=W_iy&(2)+150 Gosub Gr.do Edited!(1)=True X2%=@Wxacoord(2,0) Y2%=@Wyacoord(2,0) Gosub Defmouse(3) @Lhidem ~Graf_mkstate(Mx&,My&,B&,A&) If B&<>0 Mk&=B& Endif W%=-2 ! diff>1 H%=-2 ! diff>1 Do If Mk&=1 ! saloperie de gem $S& Select @Xmousek Case 0 Default Mk&=@Xmousek ! le 'vrai' clic est ici Endselect $S% Else if Mk&=0 Mk&=@Xmousek ! le 'vrai' clic est ici Endif ' If @Wavisible(2,Mx&,My&) ! Coord visible? ' Edited!(1)=True Gosub Coord(Mx&,My&) ! afficher coord? Mx&=@Wxrcoord(2,Mx&) ! Coord My&=@Wyrcoord(2,My&) ! relatives! If Mx&=>1 And My&=>1 And Mx&<=321 And My&<=151 ' Mx&=Mx&-2 My&=My&-2 If (Abs(Mx&-W%)<=1 And Abs(My&-H%)<=1) Or W%<0 W%=Mx& H%=My& ' Mx&=Mx&\4 My&=My&\2 ' B&=Mx&\2 ! pos x C%=My&\3 ! et pos y ' Vididx&=C%*40+B&+1 A&=Asc(Mid$(Vid$,Vididx&,1)) ' B&=Mod(Mx&,2) ! 0,1 C%=Mod(My&,3) ! 0,1,2 ' If Mk&=2 A&=Bclr(A&,(B&+C%*2)) Else if Mk&=3 A&=Bset(A&,(B&+C%*2)) Else if Mk&=1 $S& Select Mog& Case 0 ! clic gauche A&=Bset(A&,(B&+C%*2)) Case 1 A&=Bclr(A&,(B&+C%*2)) Case 2 A&=Bchg(A&,(B&+C%*2)) Endselect $S% Endif ' Mid$(Vid$,Vididx&,1)=Chr$(A&) @Lhidem @Putp(X2%+(Mx&\2)*8+2,Y2%+(My&\3)*6+$ And And And And Eqv And ,A&) @Lshowm ' Clr Acx&,Acy& ! restore loupe ' Else If Mk&=2 Gosub Do_line(W%,H%,Mx&,My&,1) Else Gosub Do_line(W%,H%,Mx&,My&,Mog&) Endif W%=Mx& H%=My& ' Endif ' Else ' Exit if True ! coord hors champ Endif ' Else ' Exit if True ! coord non visible Endif ' ~@Graf_mkstate(Mx&,My&,Mk&,A&) Loop until Mk&=0 @Caremouse @Lshowm Gosub Defmouse(0) ' Endif ' Return ' eff src Procedure Mclr ' If @Form_ok_scr(1,"[2][|"+"Effacer source de la m‚moire? |(non sauv‚ actuellement)][Confirmer|Annuler]")=1 File$(0)="" Ty&=0 Maxl&=0 Erase Page$(),Pag_adr%(),Pag_len&(),Pag_ind&() Clr Proc$ Gosub Gr.do ' Vid$=String$(1000,0) Edited!(0)=False @Test_menu ' @Menu_set @Clr_eb ~@Wind_open(0) Gosub Page_manage(0) @Hidem Rdw_all(0) Rdw_all(1) @Showm ' Gosub Comp.rst Gosub Comm.info("","") Gosub Comm.info("M","*Source effac‚") Endif Return ' cacher bloc Procedure Clr_eb Eb&=-1 Sb&=-1 @Test_menu Return ' d‚placer bloc en N% Procedure Move_b(N%) Local A%,B%,C%,E$,B$ ' Clr E$ B%=Sb& For A%=1 To Eb&-Sb&+1 E$=E$+Mki$(Len(Page$(B%)))+Page$(B%) Delete Page$(B%) If N%>B% ! deplacer aprŠs N%=Max(0,N%-1) Endif Next A% A%=N% While Len(E$)>0 C%=Cvi(Mid$(E$,1,2)) Exit if C%<0 B$=Mid$(E$,3,C%) E$=Right$(E$,Len(E$)-2-C%) Insert Page$(A%)=B$ Inc A% Wend Gosub Indentage ! rappel d'indentage ' Return ' reset videotex Procedure Mres(Key&) ' @Showm ~@Wind_update01(1) Gosub Defmouse(2) @Hidem If Key&=147 If @S_speed ! prise en compte de la vitesse? If @Form_alert(1,"[3][|Resynchronisation prise? |][Confirmer| Annuler ]")=1 @Oqp Gosub Menu.info("Resynchronisation"+" --------") Gosub Defmouse(2) @300b Outvid(Cls$+"Synchronisation"+" 6") Gosub Menu.info("Resynchronisation"+" *-------") Delay 1 Gosub Defmouse(2) @1200b Outvid(Cls$+"Synchronisation"+" 5") Gosub Menu.info("Resynchronisation"+" **------") Delay 1 Gosub Defmouse(2) @4800b Outvid(Cls$+"Synchronisation"+" 4") Delay 1 Gosub Menu.info("Resynchronisation"+" ***-----") Gosub Defmouse(2) @9600b Outvid(Cls$+"Synchronisation"+" 3") Delay 1 Gosub Menu.info("Resynchronisation"+" ****----") Gosub Defmouse(2) @300b Outvid(Cls$+"Synchronisation"+" 2") Gosub Menu.info("Resynchronisation"+" *****---") Delay 1 Gosub Defmouse(2) @9600b Outvid(Cls$+"Synchronisation"+" 1") Gosub Menu.info("Resynchronisation"+" ******--") Delay 1 Gosub Defmouse(2) @4800b Outvid(Cls$+"Synchronisation"+" 0") Delay 1 Gosub Menu.info("Resynchronisation"+" *******-") Gosub Defmouse(2) @1200b Outvid(Cls$+"Synchronisation") Delay 1 Gosub Defmouse(2) Gosub Defmouse(0) Gosub Comm.info("M","Resynchronisation") Clr Speed& @Desoqp Endif Endif Else ' If Set_speed! If @Form_alert(1,"[3][|Initialiser minitel? |][Confirmer| Annuler ]")=1 Gosub Comm.info("M","Init") Outvid(Cls$) Outvid(Cursoff$+Cls$) Outvid(@Pos$(1,0)+Space$(40)+Tv$+Chr$(13)) Outvid(Cls$+Curson$) Gosub Defmouse(0) @Videmntl @Videkbd Endif Else If @Form_alert(1,"[3][|Initialiser modem? |][Confirmer| Annuler ]")=1 Gosub Comm.info("M","Initialisation modem") Gosub Atsend(Modem$(0)) ! init Endif Endif Endif ~@Wind_update01(0) If Wopen!(1) Rdw_all(1) Endif Gosub Defmouse(0) @Showm ' Return ' ' Procedure Gr.undo If Len(Vid2$)=0 ~@Wind_update01(0) ~@Form_alert(1,"[2][|"+"Err interne programmeur |#GR01 |][ Hell! ]") Vid2$=String$(1000,0) Void Fre(0) Endif Swap Vid$,Vid2$ Edited!(1)=True Return Procedure Gr.do Vid2$=Vid$ If Len(Vid$)=0 ~@Wind_update01(0) ~@Form_alert(1,"[2][|"+"Err interne programmeur |#GR00 |][ Hell! ]") Vid$=String$(1000,0) Vid2$=String$(1000,0) Void Fre(0) Endif Return Procedure Dpoint(X%,Y%,Mog&,Flag!) Local X2%,Y2%,Vididx&,A%,B%,C% ' Edited!(1)=True X%=Min(79,Max(0,X%)) Y%=Min(74,Max(0,Y%)) ' X2%=@Wxacoord(2,0) Y2%=@Wyacoord(2,0) ' B%=X%\2 ! pos x C%=Y%\3 ! et pos y ' Vididx&=C%*40+B%+1 A%=Asc(Mid$(Vid$,Vididx&,1)) ' B%=Mod(X%,2) ! 0,1 C%=Mod(Y%,3) ! 0,1,2 ' $S& Select Mog& Case 0 ! clic gauche A%=Bset(A%,(B%+C%*2)) Case 1 A%=Bclr(A%,(B%+C%*2)) Case 2 A%=Bchg(A%,(B%+C%*2)) Endselect $S% ' Mid$(Vid$,Vididx&,1)=Chr$(A%) If Flag! @Lhidem @Putp(X2%+(X%\2)*8+2,Y2%+(Y%\3)*6+2,A%) @Lshowm Endif ' Return ' ' renvoi true ou false si le point (x,y) est allum‚ ou non Function Xptst(X%,Y%) $F% Local X2%,Y2%,Vididx&,A%,B%,C% ' X%=Min(79,Max(0,X%)) Y%=Min(74,Max(0,Y%)) ' X2%=@Wxacoord(2,0) Y2%=@Wyacoord(2,0) ' B%=X%\2 ! pos x C%=Y%\3 ! et pos y ' Vididx&=C%*40+B%+1 A%=Asc(Mid$(Vid$,Vididx&,1)) ' B%=Mod(X%,2) ! 0,1 C%=Mod(Y%,3) ! 0,1,2 Return Btst(A%,(B%+C%*2)) ' Endfunc ' ' sousous proc Procedure Voirw1 Gosub Top(1) ! NewTop Return ' sous proc Function Selectk(Key&) $F% Local X%,A&,A%,B% Local A$ Local A! Local T% Local E$ ' A&=Key& A&=@Upcase(Key&) $S& Select A& Case 187,191,192,193,188,195,196,5,212,213,12,19,189,190,500,501,17,900 To 999 ' ' Si en cours, ‚valuer If Modify! Page_manage(208) Endif If Modify! And A&<>17 ! not ^Q ' If Len(Trim$(Page$(Ty&)))<>0 And Left$(Trim$(Page$(Ty&)),1)<>"'" @Top(0) Gosub Menu.info("* Ligne en cours") ~@Infow(0,"* Ligne en cours") Restore_l0!=False @Beep Return True ' Else ' Page$(Ty&)=Trim$(Page$(Ty&)) ' Endif Endif ' Clr X% If @Firstw=0 X%=True Endif ' A&=Key& A&=@Upcase(Key&) ' If Help! Gosub Help(0,A&) ' a=0 -> annul‚ Endif Select A& Case 0 ' Case 17 ! quit ' ' Gosub Comp.rst Comm.info("","") Gosub Menu.info(Title$) X%=1 For A&=0 To 9 If Edited!(A&) X%=2 Endif Next A& A&=@Red_alert(X%,"[3][|"+"Cette op‚ration efface tous |les travaux ‚dit‚s en m‚moire|"+"Quitter|][Confirmer| Sauver | Annuler ]") ' Select A& Case 1,2 If A&=2 If @Env_save Set_end!=True Endif Else Set_end!=True Endif ' Endselect Case 187 ! Compiler f1! ' Gosub Clearv Clr Terr$,Terrp& If @Compile(True,0)<>0 @Desoqp ! on es plus oqp Beep Gosub Comm.info("C",Terr$) @Videkbd @Rshow("Compiler:",Terr$) ' Modify!=True Clr Terr$,Terrp& Else @Desoqp ! on es plus oqp Endif @Videkbd Gosub Clearv ' Case 191 ! Recevoir f5 Gosub Recept ' Case 192,193 ! D‚sassembler (maj) f6,f7 ' If @Form_ok_scr(1,"[3][|"+"Cette op‚ration efface le |source actuel|"+"D‚sassembler|][Confirmer| Annuler ]")=1 ' ' Select @Form_alert(1,"[3][|"+"D‚sassemblage: Int‚grale ou |partiel? (ascii) |][ Tout | ASCII | Annuler ]") ' Case 2 ' A&=True ! a=index=ascii ' Case 1 ' A&=False ! a=index=not ascii (normal, quoi) ' Default ' A&=1 ' Endselect ' ' If A&<>1 Clr Terr$,Terrp& Edited!(0)=True ! edition en cours @Test_menu ' @Menu_set Gosub Top(0) If @Decompile<>0 @Desoqp ! on es plus oqp Beep Gosub Comm.info("D‚sassemblage",Terr$) @Videkbd @Rshow("D‚sassemblage:",Terr$) Clr Terr$,Terrp& Else @Desoqp ! on es plus oqp Endif ! comp<>0 ' ' Endif ! are you sure? ' Endif ! Ok? @Videkbd ' Case 188 ! Optimiser F2 ' Clr Terr$,Terrp& If @Opti<>0 @Desoqp ! on es plus oqp Beep Gosub Comm.info("Optimisation",Terr$) @Videkbd Clr Terr$,Terrp& Else @Desoqp ! on es plus oqp Endif @Videkbd ' Case 195 ! DeCrunch f9 ' Clr Terr$,Terrp& If @Desopti<>0 @Desoqp ! on es plus oqp Beep Gosub Comm.info("D‚sassemblage",Terr$) @Videkbd Clr Terr$,Terrp& Else @Desoqp ! on es plus oqp Endif @Videkbd ' Case 196 ! Comp+Opt f10 ' Gosub Clearv Clr Terr$,Terrp& If @Compile(True,True)<>0 @Desoqp ! on es plus oqp Beep Gosub Comm.info("C",Terr$) @Videkbd @Rshow("Compiler:",Terr$) ' Modify!=True Clr Terr$,Terrp& ' Else If Len(Binair$(Actb&))>0 If @Opti<>0 @Desoqp ! on es plus oqp Beep Gosub Comm.info("C",Terr$) @Videkbd Clr Terr$,Terrp& ' Else @Desoqp ! on es plus oqp Endif Else @Desoqp ! on es plus oqp Endif Endif @Videkbd Gosub Clearv ' Case 5 ! Envoyer ^E Exdo!=True For A&=0 To 6 If Len(Binair$(A&))>0 ! pas vide!! Ob_state(Adr%(22),En_1&+A&)=Bclr(Ob_state(Adr%(22),En_1&+A&),3) Else Ob_state(Adr%(22),En_1&+A&)=Bset(Ob_state(Adr%(22),En_1&+A&),3) Endif Ob_state(Adr%(22),En_1&+A&)=Bclr(Ob_state(Adr%(22),En_1&+A&),0) Next A& Ob_state(Adr%(22),En_1&+Actb&)=Bset(Ob_state(Adr%(22),En_1&+Actb&),0) Char{{Ob_spec(Adr%(22),En_no&)}}=Str$(Len(Binair$(Actb&)),5) ' Do If Len(Binair$(Actb&))=0 Ob_state(Adr%(22),En_env&)=Bset(Ob_state(Adr%(22),En_env&),3) Ob_flags(Adr%(22),En_env&)=Bclr(Ob_flags(Adr%(22),En_env&),2) Else Ob_state(Adr%(22),En_env&)=Bclr(Ob_state(Adr%(22),En_env&),3) Ob_flags(Adr%(22),En_env&)=Bset(Ob_flags(Adr%(22),En_env&),2) Endif If Not Exdo! ~Objc_draw(Adr%(22),En_env&,7,Rx&(22),Ry&(22),Rw&(22),Rh&(22)) Endif ' A&=Byte(@Form_wdo(22,0)) Select A& Case En_ok&,En_env&,0,1 Exit if True Case En_1& To En_6& ! changer de bloc! Ob_state(Adr%(22),En_1&+Actb&)=Bclr(Ob_state(Adr%(22),En_1&+Actb&),0) ~Objc_draw(Adr%(22),En_1&+Actb&,7,Rx&(22),Ry&(22),Rw&(22),Rh&(22)) Actb&=A&-En_1& Ob_state(Adr%(22),En_1&+Actb&)=Bset(Ob_state(Adr%(22),En_1&+Actb&),0) ~Objc_draw(Adr%(22),En_1&+Actb&,7,Rx&(22),Ry&(22),Rw&(22),Rh&(22)) Char{{Ob_spec(Adr%(22),En_no&)}}=Str$(Len(Binair$(Actb&)),5) ~Objc_draw(Adr%(22),En_no&,7,Rx&(22),Ry&(22),Rw&(22),Rh&(22)) Endselect Loop ~@Wind_update01(0) Ob_state(Adr%(22),A&)=Bclr(Ob_state(Adr%(22),A&),0) ' ~form_dial(3,0,0,0,0,Rx&(22),Ry&(22),Rw&(22),Rh&(22)) ~@Form_wdo(22,-3) Gosub W_rdexe ' Select A& Case En_ok&,En_env& ' Vers le minitel? Redt|=0 If Btst(Ob_state(Adr%(22),En_min&),0) Redir!=False Else if Btst(Ob_state(Adr%(22),En_two&),0) Redir!=True Redt|=1 ! 1=les deux Else Redir!=True Endif If Btst(Ob_state(Adr%(22),En_slw&),0) Lim1200!=True Else Lim1200!=False Endif Endselect ' If A&=En_env& If Len(Binair$(Actb&))>0 ' If Redir! ' ' Version 1997 Clr E$ Acsw&=Appl_find("SWIFTELP") If Acsw&=>0 ' E$="*" ' ' Gosub Xxappl(Acsw&,&H1000,Ap&,0,0,0) ! version ' Sw_xmit!=True Gosub Xxappl(Acsw&,&H1002,Ap&,0,0,0,0) ! AbschId ' Gosub Xxappl(Acsw&,&H1099,105,0,0,0,0) ! Top ~Fre(0) Gosub Xxappl(Acsw&,&H1053,Len(Binair$(Actb&)),Word(Swap(V:Binair$(Actb&))),Word(V:Binair$(Actb&)),0,0) ~Evnt_timer(150) ' Endif Endif ' If Len(E$)=0 ~@Wind_update01(1) Gosub Defmouse(2) ' Gosub Part_draw(0) ! vcurs(0) If Not Lim1200! Gosub Menu.info("Envoi en cours..") Else Gosub Menu.info("Envoi en cours vitesse lente..") Endif ' A%=1 ' For A%=1 To Len(Binair$(Actb&))+15 Step 16 If Redir! A!=False @Top(4) ! topped! Gosub Set_col(True) Gosub W_rdexe Swt&=1 Else A!=True Gosub Progress(False,0,"Envoi vers le minitel") Endif ' Gosub Wind_clip(4) Clr Vtransp! Gosub Send(Cls$+Esc$+"[c") Set_send!=True Do @Hidem Send(Mid$(Binair$(Actb&),A%,16)) @Showm If Inp?(2) Or @Mousek<>0 @Videkbd ~@Wind_update01(0) Exit if @Form_alert(2,"[3][|"+"Interrompre le transfert? |][Confirmer| Annuler ]")=1 ~@Wind_update01(1) Endif If Mod(A%-1,64)=0 If A! Gosub Progress(False,(A%*100)\Len(Binair$(Actb&)),"") Else Gosub Defmouse(2) Endif Endif ' Add A%,16 Loop until A%>Len(Binair$(Actb&))+15 Set_send!=False Clr Vtransp! Clr Swt& ' Next A% If A! Gosub Progress(True,0,"") Endif ' Gosub Part_draw(1) ! vcurs(1) Gosub Comm.info("M","Envoy‚") @Showm Endif ' Gosub Defmouse(0) ~@Wind_update01(0) @Videkbd ' Else ~@Form_alert(1,"[3][|Bloc #"+Str$(Actb&+1)+" vide! |][ Annuler ]") Endif ! vide! Endif ! ok? ' Case 212 ! sF1 If @Form_ok_scr(1, f æôŸî ¸fø#È f$f$f 8çf<q½f$f$fd߀ÿf Ì ,f 0è1 fÔè&f Ì ls&  ç€è1 ßÿfv@1Ðcbè1 f$f çÀãf @&è1)Double{\:+"Cette op‚ration efface le |source actuel|"+"Load A|][Confirmer| Annuler ]")=1 @Load.lsw @Videkbd Endif ' ' Case 213 ! sF2 @Save.lsw @Videkbd ' Case 500 ! infos fichier File$=@Fsel$("\*.*",File$,"Infos") If Len(File$)>0 If @Exist(File$) ~@Wind_update01(1) Gosub Defmouse(2) B%=0 A$=File$+Chr$(0) A%=Gemdos(67,L:Varptr(A$),0,0) Clr A$ Gosub Defmouse(0) ~@Wind_update01(0) ' If A%=>0 Open "I",#1,File$ B%=Lof(#1) Close #1 Clr A$ If A%=0 A$="Normal" Else If Btst(A%,0) A$=A$+"WriteP-" Endif If Btst(A%,1) A$=A$+"Hide-" Endif If Btst(A%,2) A$=A$+"Sys-" Endif If Btst(A%,3) A$=A$+"Vol-" Endif If Btst(A%,4) A$=A$+"Rep-" Endif If Btst(A%,5) A$=A$+"Arc-" Endif Endif ~@Form_alert(1,"[0][|Fichier: "+Right$(File$,20)+" |Long: "+Str$(B%)+"o |Attribut: "+A$+" |][Confirmer]") @Comm.info("M",Right$(File$,20)+" - "+Str$(B%)+"o / "+A$) Else ~@Form_alert(1,@Errf$(A%)) Gosub Comm.info("Infos fichier","*Erreur gemdos "+Str$(A%)) Endif ' Else ~@Wind_update01(0) ~@Form_alert(1,@Errf$(-33)) Gosub Comm.info("Infos fichier","Fichier introuvable") Endif Else Gosub Comm.info("Infos fichier","annul‚") Endif ' Case 501 ! delete file File$=@Fsel$("\*.*",File$,"D‚truire") If Len(File$)>0 If @Exist(File$) If @Form_alert(1,"[2][|D‚truire le fichier: |"+Right$(File$,28)+" ?|][Confirmer| Annuler ]")=1 ~@Wind_update01(1) Gosub Defmouse(2) A$=File$+Mki$(0) A%=Gemdos(65,L:Varptr(A$)) If A%<0 ~@Wind_update01(0) ~@Form_alert(1,@Errf$(A%)) Gosub Comm.info("D‚truire fichier","*Erreur gemdos "+Str$(A%)) Else Gosub Comm.info("M","Fichier d‚truit") Endif Clr A$ Gosub Defmouse(0) ~@Wind_update01(0) Else Gosub Comm.info("D‚truire fichier","annul‚") Endif Else ~@Wind_update01(0) ~@Form_alert(1,@Errf$(-33)) Gosub Comm.info("D‚truire fichier","Fichier introuvable") Endif Else Gosub Comm.info("D‚truire fichier","annul‚") Endif ' Case 12 ~@Env_load Case 19 ~@Env_save ' Case 912 ! alt^L load If @Form_ok_scr(1,"[3][|"+"Cette op‚ration efface le |source actuel|"+"Load|][Confirmer| Annuler ]")=1 @Load.swt @Videkbd Endif Case 919 ! alt^S save If Left$(File$(0),1)=Chr$(0) If Len(File$(0))>1 If Edited!(0) File$(0)=Mid$(File$(0),2) @Save.swt Endif Endif Else If And(@Bios11,&X11)=0 If Len(File$(0))>0 If Edited!(0) File$(0)=Chr$(0)+File$(0) @Save.swt Endif Endif Else @Save.swt Endif Endif If Left$(File$(0),1)=Chr$(0) File$(0)=Mid$(File$(0),2) Endif @Videkbd Case 189 ! f3 load bin @Load.vdt @Videkbd ' Case 190 ! f4 save bin @Save.vdt @Videkbd ' Default Return 0 Endselect $S% ' Default Return 0 Endselect ' If X%=True If (Not Sw_xmit!) ! PERSO perso '97 If Wopen!(0) If @Firstw<>0 @Top(0) Endif Endif Else Sw_xmit!=False Endif Endif Return -1 ' Endfunc Procedure Selectgrf(Key&) Local A& ' $S& If Key&<=255 Key&=Asc(Upper$(Chr$(Key&))) Endif If Help! A&=Key& Gosub Help(2,A&) Key&=A& Clr A& Endif Select Key& Case 0 Case "L" ! L @Gr.do If @Form_ok_grf(1,"[3][|"+"Cette op‚ration efface le |"+"graphique actuel|Load graph|][Confirmer| Annuler ]")=1 @Load.egr Endif @Videkbd ' Case "S" ! S @Save.egr @Videkbd ' Case "E" ! E If @Form_ok_grf(1,"[3][|"+"Cette op‚ration efface le |"+"graphique actuel|Clear|][Confirmer| Annuler ]")=1 Gosub Gr.do Vid$=String$(1000,0) Edited!(1)=False @Hidem Rdw_all(2) ~@Infow(2,"Ecran effac‚") @Showm Endif @Videkbd Case 146 ! \E If @Form_ok_grf(1,"[3][|"+"Cette op‚ration efface le |"+"graphique actuel|Fill screen|][Confirmer| Annuler ]")=1 Gosub Gr.do Edited!(1)=False Vid$=String$(1000,63) @Hidem Rdw_all(2) ~@Infow(2,"Ecran rempli") @Showm @Videkbd Endif Case 147 ! ^Redraw Rdw_all(2) @Videkbd Case 40 ! haut Mog&=Mog&-1 If Mog&<0 Mog&=2 Endif Wind_clip(2) ! clipper fenˆtre 2 ' @Mog_chg Clip_off ~@Infow(2,"Mode dessin modifi‚") @Videkbd Case 41 ! bas Mog&=Mog&+1 If Mog&>2 Mog&=0 Endif Wind_clip(2) ! clipping fenˆtre ' @Mog_chg Clip_off ~@Infow(2,"Mode dessin modifi‚") @Videkbd Case "G" Coord!=Not Coord! @Hidem Rdw_all(2) @Showm If Coord! ~@Infow(2,"Coord on") Else ~@Infow(2,"Coord off") Endif @Showm @Videkbd Case 162 ! \G grille Inc Grill| If Grill|>2 Grill|=0 Endif @Hidem Rdw_all(2) $S& Select Grill| Case 0 ~@Infow(2,"Pas de grille") Case 1 ~@Infow(2,"Cadres") Case 2 ~@Infow(2,"Grillage fin") Endselect $S% @Showm @Videkbd ' Case 225 ! Undo Gosub Gr.undo @Hidem Rdw_all(2) ~@Infow(2,"DerniŠre op‚ration annul‚e") @Showm @Videkbd ' Case 203 ! left Gosub Gr.do @Left.shf @Hidem Rdw_all(2) ~@Infow(2,"Ecran d‚plac‚") @Showm @Videkbd ' Case 205 ! right Gosub Gr.do @Right.shf @Hidem Rdw_all(2) ~@Infow(2,"Ecran d‚plac‚") @Showm @Videkbd ' Case 200 ! haut Gosub Gr.do @Up.shf @Hidem Rdw_all(2) ~@Infow(2,"Ecran d‚plac‚") @Showm @Videkbd ' Case 208 ! bas Gosub Gr.do @Down.shf @Hidem Rdw_all(2) ~@Infow(2,"Ecran d‚plac‚") @Showm @Videkbd ' Case "6" ! shift-shift right Gosub Gr.do @Ss.right @Hidem Rdw_all(2) ~@Infow(2,"Ecran d‚plac‚") @Showm @Videkbd ' Case "2" ! shift-shift down Gosub Gr.do @Ss.down @Hidem Rdw_all(2) ~@Infow(2,"Ecran d‚plac‚") @Showm @Videkbd ' Case "4" ! shift-shift rleft Gosub Gr.do @Ss.left @Hidem Rdw_all(2) ~@Infow(2,"Ecran d‚plac‚") @Showm @Videkbd ' Case "8" ! shift-shift up Gosub Gr.do @Ss.up @Hidem Rdw_all(2) ~@Infow(2,"Ecran d‚plac‚") @Showm @Videkbd ' Case "I" Gosub Gr.do @Invert.shf @Hidem Rdw_all(2) ~@Infow(2,"Ecran invers‚") @Showm @Videkbd Case "X" @Dr.brush Case 8 ! backspc @H.id ~@Infow(2,"Insertion/Suppression de ligne effectu‚") ' Case 22 ! ^V @V.id ~@Infow(2,its! r$f ŠÌã f,Ìprint #5,@tran$(mid$(message$,sd_a,1)); ø—?áj!ø{!È fmpmÈCfloat(Bin$(Mkf$( With Bin$(Cvs(Trace$Cfloat(Exp(Inkey$Min(Round(Round( With Mkf$(Bin$(Bin$(Cvs(Trace$Cfloat()Mks$(Mkf$()Mkl$(Trace$ As Trace$Cfloat(Cfloat(Mkf$()Mkf$(Mkd$(Mkd$(Mkf$(Mkl$(Bin$(Min(String$() ' Case "N" ! Line @Dr.line(Key&) ~@Infow(2,"Ligne trac‚e") @Videkbd ' Case "P" ! SpLine @Dr.spline ~@Infow(2,"Courbe trac‚e") @Videkbd ' Case "C",174 ! Circle @Dr.ellips(Key&) ~@Infow(2,"Cercle trac‚") @Videkbd ' Case 244,243,4,21,150,160 ! ^move Gosub Gr.do @Xmove(Key&) ~@Infow(2,"Ecran d‚plac‚") @Videkbd ' Case 114,82,147 ! ROTATE Gosub Gr.do @Rotate(0) ~@Infow(2,"Ecran flipp‚") @Videkbd ' Case "T",148,153 ! Text @Dr.text(Key&) ~@Infow(2,"Texte incrust‚") @Videkbd ' Case "B",176,183 ! Boxs @Dr.box(Key&) ~@Infow(2,"Rectangle trac‚e") @Videkbd Case "F" ! fill @Fill(Key&) ~@Infow(2,Mkf$( Offset Round( As Cvs() @Videkbd ' Case 13,10 ! Enter!! If @Form_alert(1,"[2][|Transfert graph->‚diteur? |][Confirmer| Annuler ]")=1 $S& Select @Form_alert(1,"[2][|"+"Transf‚rer un morceau de |graphique ou tout? |][ Morceau | Tout |Tout-1 ]") Case 2 Add Key&,1000 Case 3 Add Key&,2000 Endselect $S% @Gr.2.txt(Key&) @Videkbd ~@Infow(2,"Transf‚r‚") Endif Wsetsl(0) ' Case 500 ! 500 help xmove A&=-5 If Help! Gosub Help(0,A&) Else Help!=True Gosub Help(0,A&) Help!=False Endif Clr A& ' Default ~@Infow(2,"Touche inconnue #"+Str$(Key&)+" ("+Chr$(Key&)+")") ' Endselect Gosub Waitmouse ! attendre si clic non relach‚ $S% ' Return Procedure Selectmnu(Key&) Local X&,A% ' $S& If Key&<=255 Key&=Asc(Upper$(Chr$(Key&))) Endif If Help! X&=Key& Gosub Help(1,X&) Key&=X& Clr X& Endif Select Key& Case 0 ' Case 184 ! \iNs‚rer ' @Voirw1 @Insert.lsw @Videkbd ' Case "E" ! effacer Gosub Comm.info("M","Ecran effac‚") Outvid(Cll$+Cls$) @Videkbd ' Case 161 ! save cnf \F If @Form_alert(1,"[2][|"+"Sauver la configuration? |][Confirmer| Annuler ]")=1 @Sv.cnf Endif ' Case "R",147 ! init ^R,\R ' @Voirw1 Gosub Mres(Key&) ' Case 146 ! envoyer clavier \E ' @Voirw1 ~@Wind_update01(1) Gosub Defmouse(2) Gosub Menu.info("Envoi en cours.. ctrl: stop, shft: pause") ' Set_send!=True For A%=1 To Len(Binair$(Actb&)) B%=Asc(Mid$(Binair$(Actb&),A%,1)) Select B% ' Case 10 Case 13 Print #5,Chr$(19); @Pause(7) ! 7.5c/s eh oui sur 10 bits! Print #5,"H"; ! Suite, Sep H @Pause(7) @Pause(7) Case 0 To 31 $S& Select Ascii& Case 1 Select B% Case 0 To 26,28 To 31 Print #5,"$"; @Pause(7) Print #5,Chr$(64+B%); @Pause(7) Case 27 Print #5,"#"; @Pause(7) Endselect Default Select B% Case 0 To 15 Print #5,"$"; @Pause(7) Print #5,„â!Èf( oÑüç"h“ü(; @Pause(7) Print #5,Hex$(B%,1); @Pause(7) Case 0 To 26,28 To 31 Print #5,"$"; @Pause(7) Print #5,Hex$(B%,2); @Pause(7) @Pause(7) Case 27 Send2("#") @Pause(7) Endselect Endselect $S% Case 32 To ' Print #5,@Tran$(Chr$(B%)); @Tran(Chr$(B%)) Print #5,Tr_t$; @Pause(7) ! 7.5c/s eh oui sur 10 bits! Endselect Select @Shift Case 4 ! stop Exit if True Case 2,1,3 ! pause Gosub Menu.info("Pause, relachez") While @Shift<>0 Wend Gosub Menu.info("Envoi en cours.. ctrl: stop, shft: pause") Endselect Next A% Set_send!=False ' Gosub Comm.info("M","Envoy‚") Gosub Defmouse(0) ~@Wind_update01(0) @Videkbd ' ' Case "O",16 ! Options ' Char{{Ob_spec(Adr%(1),Rsc_num&)}}=Str$(Set_mtime%,3) ' Dessiner objet-options! ' Rselect(Rsc_comp&,False) Rselect(Rsc_eff&,False) Rselect(Rsc_mul&,False) Rselect(Rsc_len&,False) Rselect(Rsc_dyn&,False) ' If Not Efdesk! Rselect(Rsc_bak&,True) Else Rselect(Rsc_bak&,False) Endif If Slow! Rselect(Rsc_len&,True) Endif If Expert! Rselect(Rsc_dyn&,True) Endif Gosub Sel_pop(Adr%(1),Rsc_vdt&,Abs(Acc!)+1) If Set_multi! Rselect(Rsc_mul&,True) Endif If Effect! Rselect(Rsc_eff&,True) Endif If Autosend! Rselect(Rsc_comp&,True) Endif ' If Not Linea! Rselect(Rsc_log&,True) Else Rselect(Rsc_log&,False) Endif ' ' Rselect(Rsc_d0&+Defl&,True) Gosub Sel_pop(Adr%(1),Rsc_d0&,Defl&+1) ' Gosub Sel_pop(Adr%(1),Rsc_ema0&,Ascii&+1) ' If Set_speed! Gosub Sel_pop(Adr%(1),Rsc_1200&,Speed&+1) Else Gosub Sel_pop(Adr%(1),Rsc_1200&,5) ! MoDem Endif ' Gosub Sel_pop(Adr%(1),Rsc_b1&,Actb&+1) ' ~Objc_draw(Adr%(1),0,255,Rx&(1),Ry&(1),Rw&(1),Rh&(1)) ' Exdo!=True Do A%=Byte(@Form_wdo(1,0)) Select A% Case Rsc_moins& Set_mtime%=Max(1,Set_mtime%-1) Char{{Ob_spec(Adr%(1),Rsc_num&)}}=Str$(Set_mtime%,3) ~Objc_draw(Adr%(1),Rsc_num&,255,Rx&(1),Ry&(1),Rw&(1),Rh&(1)) Case Rsc_plus& Set_mtime%=Min(32,Set_mtime%+1) Char{{Ob_spec(Adr%(1),Rsc_num&)}}=Str$(Set_mtime%,3) ~Objc_draw(Adr%(1),Rsc_num&,255,Rx&(1),Ry&(1),Rw&(1),Rh&(1)) Case Rsc_mem& Ob_state(Adr%(1),Rsc_mem&)=Bclr(Ob_state(Adr%(1),Rsc_mem&),0) ~Objc_draw(Adr%(1),Rsc_mem&,&HFF,Rx&(1),Ry&(1),Rw&(1),Rh&(1)) Exdo!=True ' ~form_dial(3,0,0,0,0,Rx&(1),Ry&(1),Rw&(1),Rh&(1)) ~@Form_wdo(1,-3) @W_rdexe Allfree Default Exit if True Endselect Loop Rselect(A%,False) ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(1),Ry&(1),Rw&(1),Rh&(1)) ~@Form_wdo(1,-3) Gosub W_rdexe ' Select A% Case Rsc_ok&,Rsc_save& ' If Not Btst(Ob_state(Adr%(1),Rsc_bak&),0) Efdesk!=True Else Efdesk!=False Endif If Btst(Ob_state(Adr%(1),Rsc_len&),0) Slow!=True Else Slow!=False Endif If Btst(Ob_state(Adr%(1),Rsc_dyn&),0) Expert!=True Else Expert!=False Endif Acc!=(@State_pop(Adr%(1),Rsc_vdt&)=2) If Btst(Ob_state(Adr%(1),Rsc_mul&),0) Set_multi!=True Else Set_multi!=False Endif If Btst(Ob_state(Adr%(1),Rsc_eff&),0) Effect!=True Else Effect!=False Endif If Btst(Ob_state(Adr%(1),Rsc_comp&),0) Autosend!=True Else Autosend!=False Endif X&=@State_pop(Adr%(1),Rsc_b1&)-1 Setactb(X&) ' X&=@State_pop(Adr%(1),Rsc_d0&)-1 If X&<>Defl& Gosub Defl(X&) Rdw_all(0) Endif ' If Not Btst(Ob_state(Adr%(1),Rsc_log&),0) If Not Linea! Gosub Defmouse(2) Erase Blt$() Linea!=True Gosub Mloadfnt Gosub Clear_cache Gosub Defmouse(0) Endif Else If Linea! Gosub Defmouse(2) Erase Blt$() Linea!=False Gosub Mloadfnt Gosub Defmouse(0) Gosub Clear_cache Endif Endif ' If Not Wopen!(Nombre_w&-1) ' If Not accessoire! ' If Efdesk! ~@Wind_open(Nombre_w&-1) ! Info desk For A%=Nbr_idxw&-1 Downto 0 If Wopen!(A%) Gosub Xtop(A%) ! NewTop Gosub W_rdexe Endif Next A% ' Gosub Xtop(1) ! NewTop Endif ' Endif Else If Not Efdesk! ~@Wind_close(Nombre_w&-1) ! Info desk Endif Endif ' X&=@State_pop(Adr%(1),Rsc_1200&)-1 If Speed&<>X& Speed&=X& If X&=4 @Setspeed Set_speed!=False ! ne plus prendre en cmpte la vitesse Gosub Comm.info("M","Initialisation modem") Gosub Atsend(Modem$(0)) ! init ' Else Set_speed!=True Select Speed& Case 0 Gosub Comm.info("M","Passage en "+"1200b") Case 1 Gosub Comm.info("M","Passage en "+"4800b") Case 2 Gosub Comm.info("M","Passage en "+"9600b") Case 3 Gosub Comm.info("M","Passage en "+"300b") Endselect @Setspeed Endif Endif ' ' If Btst(Ob_state(Adr%(1),Rsc_ema0&),0) ' Ascii&=0 ' Else if Btst(Ob_state(Adr%(1),Rsc_ema1&),0) ' Ascii&=1 ' Else if Btst(Ob_state(Adr%(1),Rsc_ema2&),0) ' Ascii&=2 ' Endif Ascii&=@State_pop(Adr%(1),Rsc_ema0&)-1 ' If A%=Rsc_save& Gosub Sv.cnf Endif ' Endselect $S% ' Case "1" To "6" Setactb(Key&-49) @Hidem If Wopen!(1) Rdw_all(1) Endif Gosub Comm.info("M","Bloc VDT actuel: "+Str$(Actb&+1)+", longueur: "+Str$(Len(Binair$(Actb&)))+" octets.") @Showm @Videkbd Case "0" To "9" ' ne rien faire! Case 208 If Actb&<5 Setactb(Min(5,Actb&+1)) @Hidem If Wopen!(1) Rdw_all(1) Endif Endif Gosub Comm.info("M","Bloc VDT actuel: "+Str$(Actb&+1)+", longueur: "+Str$(Len(Binair$(Actb&)))+" octets.") @Showm @Videkbd Case 200 If Actb&>0 Setactb(Max(0,Actb&-1)) @Hidem If Wopen!(1) Rdw_all(1) Endif Endif Gosub Comm.info("M","Bloc VDT actuel: "+Str$(Actb&+1)+", longueur: "+Str$(Len(Binair$(Actb&)))+" octets.") @Showm @Videkbd ' Case "A" ! Ascii Inc Ascii& If Ascii&>2 Ascii&=0 Endif If Wopen!(1) Rdw_all(1) Endif Select Ascii& Case 1 Gosub Comm.info("M","Envoi"+" cod‚ en ascii"+" 1") Case 2 Gosub Comm.info("M","Envoi"+" cod‚ en ascii"+" 2") Default Gosub Comm.info("M","Envoi"+" en vid‚otex") Endselect ' Gosub Menu_set @Videkbd ' Case "T" ! taille texte Gosub Select_text(False) ' Case 1 ! Compiler ascii ' Gosub Clearv Clr Terr$,Terrp& If @Compile(False,0)<>0 @Desoqp ! on es plus oqp Beep Gosub Comm.info("C",Terr$) @Videkbd @Rshow("Compiler ascii:",Terr$) Clr Terr$,Terrp& ' Modify!=True Else @Desoqp ! on es plus oqp Endif ' Gosub Menu_set @Videkbd Gosub Clearv ' Case "L" ! NormV Slow!=Not Slow! If Wopen!(1) Rdw_all(1) Endif @Videkbd If Slow! Gosub Comm.info("M","Vitesse"+" lente 75b") Else Gosub Comm.info("M","Vitesse"+" normale") Endif ' Gosub Menu_set ' Case "W" Gosub Arrange_w ' Case "I",151,9,"?" If Key&=Asc("?") And @Mousek=1 ! perso Select @Form_alert(1,"[3][|Stop? |][ Brk |Interrupt | Annuler ]") Case 1 Stop Case 2 Monitor Endselect Compinf$(0)="I : plus d'infos" For X&=1 To Min(8*$ And And And And Eqv Xor ,Len(Malloc$)) Step 8 Compinf$((X&-1)\8+1)="Bloc "+Str$(Cvl(Mid$(Malloc$,X&+4,4)),10)+"o en $"+Hex$(Cvl(Mid$(Malloc$,X&,4)),8) Next X& Rdw_all(1) ' Else if Key&=Asc("I") And @Mousek=1 ! perso Compinf$(1)="Sweetel version 2.0" Compinf$(2)=" langages GfA C ASM" Compinf$(3)=" 35000 2000 2500" Compinf$(4)="Atari ST/.. GEM MiNT Ttes r‚sol" Compinf$(5)="" Compinf$(6)="Programme FreeWare mais prot‚g‚ contre toute modification" Compinf$(7)="Logiciel sous license PARX" Compinf$(8)="" Compinf$(9)="May the Power without the price Be with You! " Compinf$(10)="" Compinf$(11)="®®(c) (c) (c) (c) (c) (c)¯¯ Control-Shift-Z" Compinf$(12)=Test6 And Trunc( Or Gosub And Mod 13)="BasePage: "+Hex$(Basepage,8) Compinf$(13)="BasePage: "+Hex$(Basepage,8) Compinf$(14)="Malloc: "+Str$(Malloc(-1)) Compinf$(15)= With Mkf$(}Left$()))))+Str$(Fre(0)) Compinf$(16)="" Rdw_all(1) Else ' @Defmouse(0) @Showm Gosub Info @Showm Endif ' ' ase 225 ! Size UNDO ' ' If @Form_ok_scr(1,"[3][|"+"Cette op‚ration efface le |source actuel|"+"Reserve|][Confirmer| Annuler ]")=1 ' @Allfree ' Else ' Gosub Menu.info("..Annul‚") ' Endif ' @Videkbd ' Case 3 Gosub Mclr ' Case 23 For A%=0 To Nombre_w&-2-1 ~@Wind_open(A%) @W_rdexe Next A% Gosub Menu.info("Toute fenˆtres ouvertes") ' Case 13 ! redraw all @Print(Chr$(27)+"E") Gosub Defmouse(2) ~Form_dial(3,0,0,0,0,X_desk&,Y_desk&,W_desk&,H_desk&) If Menu_adr%>0 Menu_close Menu_open Endif W_rdexe Gosub Defmouse(0) Videkbd Case 26 ! ^Z Casse brique If And(@Bios11,&X110)=&X110 If Wopen!(1) If @Tstwork(1) If W_iw&(1)>300 And W_ih&(1)>100 @C_b Endif Endif Endif Endif ' Default Gosub Menu.info("Touche inconnue #"+Str$(Key&)+" ("+Chr$(Key&)+")") Endselect $S% Return ' ' Infos Procedure Info Local A%,X%,Y%,X2%,Y2%,W%,H%,A%,B%,W2%,H2% ' Set_system&=0 ! pas de tache de fond Outvid(Cls$+Tv$) ' Gosub Comp.rst Gosub Menu.info(Title$) ' ~@Wind_update01(1) @Wmove(0,0,0,0,Rx&(2),Ry&(2),Rw&(2),Rh&(2)) If Help! Ob_state(Adr%(2),Rsc_ihlp&)=Bset(Ob_state(Adr%(2),Rsc_ihlp&),0) Else Ob_state(Adr%(2),Rsc_ihlp&)=Bclr(Ob_state(Adr%(2),Rsc_ihlp&),0) Endif ~@Form_exdo(2,-2) ! draw ' ~Objc_draw(Adr%(2),0,255,Rx&(2),Ry&(2),Rw&(2),Rh&(2)) @Wmove(Rx&(2),Ry&(2),1,1,Rx&(2)-8,Ry&(2)-8,16,16) @Wmove(Rx&(2)+Rw&(2),Ry&(2)+Rh&(2),1,1,Rx&(2)+Rw&(2)-8,Ry&(2)+Rh&(2)-8,16,16) @Wmove(Rx&(2),Ry&(2)+Rh&(2),1,1,Rx&(2)-8,Ry&(2)+Rh&(2)-8,16,16) @Wmove(Rx&(2)+Rw&(2),Ry&(2),1,1,Rx&(2)+Rw&(2)-8,Ry&(2)-8,16,16) X%=0 Y%=Ob_h(Adr%(0),0)-Ob_h(Adr%(2),Rsc_ibox&) X2%=Ob_x(Adr%(0),0) Y2%=Ob_y(Adr%(0),0) W%=Ob_x(Adr%(2),0)+Ob_x(Adr%(2),Rsc_ibox&) H%=Ob_y(Adr%(2),0)+Ob_y(Adr%(2),Rsc_ibox&) Do Ob_x(Adr%(0),0)=W%-X% Ob_y(Adr%(0),0)=H%-Y% ~Objc_draw(Adr%(0),0,255,W%,H%,Ob_w(Adr%(2),Rsc_ibox&),Ob_h(Adr%(2),Rsc_ibox&)) A%=Byte(@Form_exdo(2,999)) If A%=Rsc_ibox& ' A%=Mousex+X% B%=Mousey+Y% Gosub Defmouse(4) While @Xmousek<>0 X%=Min(400,Max(-400,A%-Mousex)) Y%=Min(200,Max(-200,B%-Mousey)) If X%<>W2% Or Y%<>H2% Ob_x(Adr%(0),0)=W%-X% Ob_y(Adr%(0),0)=H%-Y% ' Vsync ~Objc_draw(Adr%(2),0,255,W%,H%,Ob_w(Adr%(2),Rsc_ibox&),Ob_h(Adr%(2),Rsc_ibox&)) ~Objc_draw(Adr%(0),0,255,W%,H%,Ob_w(Adr%(2),Rsc_ibox&),Ob_h(Adr%(2),Rsc_ibox&)) Endif W2%=X% H2%=Y% Wend Gosub Defmouse(0) ' Else if Btst(Ob_state(Adr%(2),A%),14) Exit if True Endif Loop until A%=Rsc_iok& Or A%=0 Ob_state(Adr%(2),A%)=Bclr(Ob_state(Adr%(2),A%),0) Ob_x(Adr%(0),0)=X2% Ob_y(Adr%(0),0)=Y2% Help!=Btst(Ob_state(Adr%(2),Rsc_ihlp&),0) ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(2),Ry&(2),Rw&(2),Rh&(2)) ~@Form_exdo(2,-3) Gosub W_rdexe @Wmove(Rx&(2),Ry&(2),8,8,8,8,8,8) @Wmove(Rx&(2)+Rw&(2),Ry&(2),8,Rh&(2),X_desk&+W_desk&,8,8,8) @Wmove(Rx&(2),Ry&(2)+Rh&(2),8,8,8,Y_desk&+H_desk&,8,8) @Wmove(Rx&(2)+Rw&(2),Ry&(2)+Rh&(2),8,8,X_desk&+W_desk&,Y_desk&+H_desk&,8,8) ' Return ' Stones breaker .. Procedure C_b Local A&,B&,K& ! vars loc Local X&,Y&,W&,H& ! screen Local X2& ! xpos Local G$,A$,B$ ! get Local Ry& ! random Local D& ! size stone Local C& Local P& ! pts Local L& ! level Local I& ! timer stop Local N& ! nbr col ' ~@Wind_update01(1) ~@Titlew(1,"®Stones breaker¯ v1.0 ["+Name$+"]") ~@Infow(1,"Get ready!! - Left/Right shift, space - Score: 0") ' X&=@Wxacoord(1,0) Y&=@Wyacoord(1,0) W&=W_iw&(1) H&=W_ih&(1) D&=(H&-16)\3 Clr P& L&=1 I&=10 N&=Work_out(13) ' @Wind_clip(1) @Lhidem ' If N&=2 @Deffillcol(0) Else @Deffillcol(4) Endif @Pbox(X&,Y&,X&+12,Y&+D&) @Xgbox(X&+2,Y&+4,X&+6,Y&+D&-4) @Color(9) For A&=1 To 20 Plot X&+2+Random(4),Y&+6+Random(D&-10) Next A& @Get(X&,Y&,X&+7,Y&+D&-4,G$) ' If N&=2 @Deffillcol(0) Else @Deffillcol(4) Endif @Pbox(X&,Y&,X&+10,Y&+10) ' @Get(X&,Y&,X&+10,Y&+7,B$) ' @Deffillcol(3) @Pbox(X&+4,Y&,X&+6,Y&+4) @Pbox(X&,Y&+4,X&+10,Y&+7) @Color(6) @Box(X&,Y&+4,X&+10,Y&+7) @Color(0) @Line(X&+5,Y&,X&+5,Y&+7) @Get(X&,Y&,X&+10,Y&+7,A$) @Deffillcol(0) @Pbox(X&,Y&,X&+12,Y&+D&) ' X2&=W&/2 C_i Do B&=@Bios11 If Inp?(2) K&=Inp(2) While Inp?(2) ~Inp(2) Wend Else Clr K& Endif If Btst(B&,1) ! gauche @Put(X&+X2&-5,Y&+H&-10,B$) If X2&<=5 X2&=W&-5 Else X2&=Max(5,X2&-4) Endif @Put(X&+X2&-5,Y&+H&-10,A$) Else if Btst(B&,0) ! droite @Put(X&+X2&-5,Y&+H&-10,B$) If X2&=>W&-5 X2&=5 Else X2&=Min(W&-5,X2&+4) Endif @Put(X&+X2&-5,Y&+H&-10,A$) Endif ' If I&=0 Inc C& If C&>3 Clr C& Endif If C&=2 Scr_copy(X&+2,Y&,W&-2,D&,X&,Y&) Endif If C&<>0 Scr_copy(X&+2,Y&+D&,W&-2,D&,X&,Y&+D&) Endif Scr_copy(X&+2,Y&+D&*2,W&-2,D&,X&,Y&+D&*2) If C&=1 Ry&=Random(12+L&*6) If Ry&<=2 @Deffillcol(Random(N&)) @Put(X&+W&-15,Y&+D&*Ry&,G$) Endif Endif Else Dec I& Vsync Endif ' If K&>0 Select K& Case 32 P&=Max(0,P&-1) Clr A& If Point(X&+X2&,Y&+D&\2)<>4 Inc A& Endif If Point(X&+X2&,Y&+D&+D&\2)<>4 Inc A& Endif If Point(X&+X2&,Y&+D&*2+D&\2)<>4 Inc A& Endif Select A& Case 3 Add P&,200 Add I&,100 ~@Infow(1,"ððð Touch‚ ððð TIMER STOP: "+Str$(I&)) Case 2 Add P&,20 Add I&,25 ~@Infow(1,"== Touch‚ == timer stop: "+Str$(I&)) Case 1 ~@Infow(1,"- Touch‚ -") Add P&,2 Endselect @Color(4) @Line(X&+X2&,Y&,X&+X2&,Y&+H&-16) ~@Infow(1,"Score: "+Str$(P&)) If P&=>500 Inc L& ~@Titlew(1,"®Stones breaker¯ LEVEL "+Str$(L&)+" ["+Name$+"]") ~@Infow(1,"Welcome to level "+Str$(L&)+" !!") Sub P&,500 C_i Endif Case "P","p" ! pause (discrŠte) ~@Titlew(1,"Panneau de commandes ["+Name$+"]") ~@Infow(1, With Mkf$(Bin$(Bin$()Char{)Cvd(Mkf$(Single{) @Deffillcol(0) @Pbox(X&,Y&,X&+W&-1,Y&+H&-1) Select Inp(2) Case 27,3 Exit if True Endselect If L&=1 ~@Titlew(1,Inkey$Bin$(Trace$Cfloat(Mkf$(Bin$()Mki$( With Mkf$(Char{Cvd(Mkf$( With Off)Min(Log10((Log()\+Name$+"]") Else ~@Titlew(1,"®Stones breaker¯ LEVEL "+Str$(L&)+" ["+Name$+"]") Endif ~@Infow(1,"Let's restart!!") X2&=W&/2 C_i Endselect Endif ' Vsync Loop until K&=27 @Lshowm ' ~@Titlew(1,"Panneau de commandes ["+Name$+"]") @Drawx(1) Rdw_all(1) ~@Wind_update01(0) Return Procedure C_i For A&=1 To W&\2 @Color(Mod(A&,N&)) @Box(X&+A&,Y&+(A&*H&)/W&,X&+W&-1-A&,Y&+H&-1-(A&*H&)/W&) If Mod(A&,8)=0 Vsync Endif Next A& ' @Color(4) For A&=1 To W&\2 @Box(X&+A&,Y&+(A&*H&)/W&,X&+W&-1-A&,Y&+H&-1-(A&*H&)/W&) If Mod(A&,4)=0 Vsync Endif Next A& If N&=2 @Deffillcol(0) Else @Deffillcol(4) Endif @Pbox(X&,Y&,X&+W&-1,Y&+H&-1) @Put(X&+X2&-2,Y&+H&-10,A$) ' Return ' Procedure Page_manage(Key&) Local Reponse%,T$,X%,X&,Y%,Y&,A%,E$ Local Flag! ! redraw? ' If Key&=0 ' =0 If Dim?(Page$())=0 Modify!=False Dim Page$(Dims&+8) Dim Pag_adr%(Dims&+8) Dim Pag_len&(Dims&+8) Dim Pag_ind&(Dims&+8) If Len(Vid$)=0 Let Vid$=String$(1000,0) Endif If Len(Vid2$)=0 Let Vid2$=String$(1000,0) Endif ' Let Vid$=String$(1000,0) If Dim?(Binair$())=0 Dim Binair$(6) ! 4=pour import drcs Endif Maxty&=0 ! 1 lignes Gosub Indentage ! rappel d'indentage Endif Ty&=0 Do_winit(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,"") ' ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,T$) @Wsetcm(Page_id&,True) Dwx_&(Page_id&)=1 Restore_l0!=True ' Else if Key&=-1 ! Redraw ' If Wopen!(0) X%=@Wxrcoord(0,W_ix&(Page_id&)) Y%=@Wyrcoord(0,W_iy&(Page_id&)) Div X%,Ccsizex& Div Y%,Ccsizey& For A%=Y% To Min(Dims&,Y%+(W_ih&(Page_id&)\Ccsizey&)+1) @Pm_line(A%) Next A% Endif ' Else if Key&=-2 ! help instruction ' T$=Page$(Ty&) Gosub Helpme(T$) If @Instrwork(T$) ! r‚ indenter ou redessiner Page$(Ty&)=T$ Gosub Indentage Rdw_all(0) Else Page$(Ty&)=T$ Endif Modify!=True Dwx_&(Page_id&)=Min(A%,Len(Page$(Ty&))+1) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,T$) Clr Key& Page_manage(208) ' Else ' Flag!=False ! not redraw ' $S& Select Key& Case 162 ! InsertGraph \G If Not Modify! If Left$(Page$(Ty&),4)="TXT " ~@Wind_update01(1) Gosub Defmouse(2) ' T$=Mid$(Page$(Ty&),5) ' T$=Mid$(T$,1,Instr(T$,Quote$)-1) If @Vals(False,T$,E$) T$=E$ ' ' If A%>Len(T$) E$=Right$(Vid$,40) Vid$=E$+Left$(Vid$,960) For A%=1 To Len(T$) X&=Asc(Mid$(T$,A%,1)) ' If X&=>32 ' If X&>96 X&=And(X&,&X1011111) Endif Sub X&,32 ' If X&=>0 And X&<=63 Mid$(Vid$,A%,1)=Chr$(X&) Endif ' Endif ' Next A% ~@Infow(Page_id&,"Ligne transf‚r‚e vers l'‚diteur") ~@Wind_open(2) Rdw_all(2) Edited!(1)=True Else ~@Infow(Page_id&,Terr$) @Beep Endif ' Gosub Defmouse(0) ~@Wind_update01(0) Restore_l0!=False Else ~@Infow(Page_id&,"Ce n'est pas une instruction TXT") @Beep Endif Else ~@Infow(Page_id&,"Ligne en cours d'‚dition") @Beep Endif Clr Key&,T$,E$ ' Case 146 ! Evaluate \E ' T$="" Do T$=@Rinput$("Evaluer une expression:",T$) T$=@Epure$(T$) If Len(T$)>0 Clr E$ Div0%=False Resultat#=@Analyste(T$,E$) If Len(E$)=0 ~@Form_alert(1,"[2][|R‚sultat: "+Str$(Resultat#)+"|"+Space$(30)+"][Confirmer]") ~@Infow(Page_id&,"R‚sultat: "+Str$(Resultat#)) Exit if True Else Beep ~@Infow(Page_id&,E$) Endif Else Exit if True Endif Loop @Videkbd Restore_l0!=False Clr Key& ' Case 175 ! Analyse all \V ' Gosub Defmouse(2) @F10 ! v‚rifier toute la syntaxe de toute les lignes Gosub Indentage ! rappel d'indentage @Videkbd Restore_l0!=False Gosub Defmouse(0) Clr Key& ' Case 161,177 ! \Find ' If Key&=161 T$=@Rinput$("Chercher: (-A ignorer MAJ/min)",Find$) If Len(T$)>0 Find$=T$ Endif Clr A% Else T$=Find$ A%=Ty& Endif ' If Len(T$)>0 Y&=Instr(T$,"-A") If Y&>0 T$=Left$(T$,Y&-1)+Mid$(T$,Y&+2) T$=Upper$(T$) Endif ' Clr X& Do Inc A% If Y&>0 ! -A X&=Instr(Upper$(Page$(A%)),T$) Else X&=Instr(Page$(A%),T$) Endif Loop until A%=>Maxty& Or X&<>0 ' If X&<>0 Ty&=A% Dwx_&(Page_id&)=X& T$=@Defm$(Ty&) @Hidem ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,T$) ~@Do_winput(Page_id&,-1,Ccsizey&+Ccsizey&*Ty&,0,Maxstr&,T$) ' Rdw_all(0) Flag!=True ! Redessiner fenˆtre ~@Infow(Page_id&,"Trouv‚") @Showm Else @Beep ' Rdw_all(0) Flag!=True ! Red‚ssiner fenˆtre ~@Infow(Page_id&,"Introuvable!") Endif ' Else If Key&=177 @Beep ~@Infow(Page_id&,"Aucune autre recherche!") Endif Endif @Videkbd Restore_l0!=False Clr Key& @Test_menu ' Case 174 ! curs ' @Wherexy(X&,Y&) Page$(Ty&)="POS "+Str$(X&)+","+Str$(Y&) T$=@Defm$(Ty&) Dwx_&(Page_id&)=Len(Page$(Ty&))+1 ~@Do_winput(Page_id&,-1,-1,&H1,Maxstr&,T$) Clr Key& Gosub Indentage ! rappel d'indentage ' Case 25 ! ^Y If Ty&Eb& Swap Sb&,Eb& Endif Do_wkill(Page_id&) T$=@Defm$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,T$) ' Rdw_all(0) Flag!=True ! Red‚ssiner fenˆtre Clr Key& @Test_menu ' Case 31 ! ^Del block ' If Sb&<>-1 And Eb&<>-1 Gosub Defmouse(2) B%=Sb& For A%=1 To Eb&-Sb&+1 Delete Page$(B%) Dec Maxty& Next A% Ty&=Max(0,Min(Maxty&-2,My%)) @Page_set Wsetsl(0) Gosub Indentage ! rappel d'indentage ' Void Fre(0) @Clr_eb Do_wkill(Page_id&) T$=@Defm$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,T$) Gosub Defmouse(0) ' Rdw_all(0) Flag!=True ! Red‚ssiner fenˆtre ~@Infow(Page_id&,"Bloc effac‚") Restore_l0!=False Else @Beep ~@Infow(Page_id&,"Pas de bloc") Restore_l0!=False Endif Clr Key& @Test_menu ' Case 16 ! ^P, print block If Sb&=-1 Or Eb&=-1 A%=@Form_alert(1,"[2][|Print text? |][Confirmer| Annuler ]") Else A%=@Form_alert(1,"[2][|Print block? |][Confirmer| Annuler ]") Endif If A%=1 If Gemdos(17) ' If Sb&=-1 Or Eb&=-1 X&=0 Y&=Maxty& Else X&=Sb& Y&=Eb& Endif A%=X& ' Gosub Defmouse(2) @Lprintl("") Do @Lprintl(Space$(Pag_ind&(A%))+@Defm$(A%)) Inc A% If @Shiftbrk Or Inp?(2) Exit if @Form_alert(1,f Var Double{\: Downto Cfloat(Bin$(Mkf$( With With Trace$ Offset Round( With Mkf$()Cvs( Offset Round( With Mkf$(Bin$(Bin$(Cvs(Trace$Cfloat(Mid$(:Double{\}=Trace$Cfloat(Mkd$(Cvs( With Offset Mkf$( With :)Asin(Cfloat(Cfloat(Min( As Mkf$( With )Double{)=1 Endif Loop until A%>Y& @Lprintl("") Gosub Defmouse(0) ' Else ~@Form_alert(1,@Errf$(-9)) Endif Endif ' Rdw_all(0) Flag!=True ! Red‚ssiner fenˆtre Clr Key& ' Case 165 ! \K Eb&=Ty& If Sb&=-1 Sb&=0 Endif If Eb&-1 Or Sb&<>-1 Gosub Clr_eb Do_wkill(Page_id&) T$=@Defm$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,T$) ' Rdw_all(0) Flag!=True ! Red‚ssiner fenˆtre Endif Clr Key& @Test_menu Case 22 ! ^moVe block ' If Sb&<>-1 And Eb&<>-1 Gosub Move_b(Ty&) ! move block @Page_set Wsetsl(0) ' Void Fre(0) @Clr_eb Do_wkill(Page_id&) T$=@Defm$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,T$) Gosub Defmouse(0) ' Rdw_all(0) Flag!=True ! Red‚ssiner fenˆtre ~@Infow(Page_id&,"Bloc d‚plac‚") Restore_l0!=False Else @Beep ~@Infow(Page_id&,"Pas de bloc") Restore_l0!=False Endif Clr Key& @Test_menu ' Case 225 ! undo ' If Len(Lastl$)>0 And Modify!=True Page$(Ty&)=Lastl$ Gosub Indentage ! rappel d'indentage T$=Lastl$ Dwx_&(Page_id&)=Min(A%,Len(Page$(Ty&))+1) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,T$) ' ~@Do_winput(Page_id&,-1,-1,-1,Maxstr&,T$) Clr Key& Endif ' Endselect ! of select key& $S% ' ' Au sujet de Modify!: Si Modify!=true, cela signifie que ' la ligne qui va etre quittee a ete modifiee. ' Dans ce cas, on v‚rifie la syntaxe (prend du temps) ' Ainsi si l'utilisateur parcours le texte avec les flŠches ' il ne mettra pas 1 siŠcle!! ' @Hidem ! 1er hidem ' Entr‚e Do_winput: If Key&<>0 If Not Modify! T$=@Defm$(Ty&) Else T$=Page$(Ty&) Endif If Key&>0 Reponse%=@Do_winput(Page_id&,-1,-1,Key&,Maxstr&,T$) Else Edited!(0)=True @Test_menu Modify!=True Endif Restore_l0!=True ' If Reponse%<0 ' ' Page$(Ty&)=T$ If Modify!=True If Len(T$)>0 A%=Len(T$) T$=@Epure$(T$) If A%<>Len(T$) And Len(T$)>0 Edited!(0)=True @Test_menu Endif Clr A% Endif Endif ' A=-1 If Len(T$)=0 Delete Page$(Ty&) Gosub Indentage ! rappel d'indentage Dec Maxty& If Len(Page$(Ty&))>0 Dwx_&(Page_id&)=Min(A%,Len(Page$(Ty&))+1) Else Dwx_&(Page_id&)=0 Endif T$=Page$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,T$) If Ty&<=Maxty&-2 ' Rdw_all(0) Flag!=True ! Red‚ssiner fenˆtre Endif @Page_set Wsetsl(0) ' Clr T$ ' Wdobox(0,0) ' A=0 Endif ' A%=0 If Len(T$)>0 ' If Modify!=True ' If 1=1 ' ' If (A=-1) Or (Modify!=False) If Modify!=True T$=@Abrev$(T$,A%) Endif ' If A%<>0 A%=1 Terr$="Instruction "+"inconnu"+"e" Endif ' Endif ' Endif If A%=0 ' If Modify!=True If A%=0 A%=@Testi(T$) If A%<>0 If A%>Len(T$)+1 T$=T$+Chr$(32) Endif Dwx_&(Page_id&)=Min(A%,Len(T$)+1) Endif Endif Page$(Ty&)=T$ ' Else A%=0 Endif ' If Len(Page$(Ty&))>0 ' Dwx_&(Page_id&)=Min(A%,Len(Page$(Ty&))+1) ' Else ' Dwx_&(Page_id&)=0 ' Endif ' ~ @Do_winput(Page_id&,-1,-1,&H0,Maxstr&,T$) Endif ' If A%=0 ! Ok ' If Modify! X&=1 ' ' Si on met en guillemets un FOR ou autre il faut ' redessinr la structure! If Left$(T$,1)="'" X&=3 Endif ' $S% Select Mid$(T$,X&,4) Case "NEXT","UNTI","ENDI","RETU","FORS","FOR ","REPE","PROC","ELSE" Gosub Indentage ! Indentation! Flag!=True ! Red‚ssiner fenˆtre ! redraw Default Select Mid$(T$,X&,3) Case "IF ","DO " Gosub Indentage Flag!=True ! redraw Default Select Mid$(T$,X&,2) Case "IF" Gosub Indentage Flag!=True ! redraw Default Select Mid$(T$,X&,1) Case "{","}","\" ! +,-,stop Gosub Indentage Flag!=True ! redraw Endselect Endselect Endselect Endselect Endif ! si modifi‚! ' ' ' If Dwx_(Page_id&)<=Len(Page$(Ty)) Or Ty=>Maxty-2 If Ty&=>Maxty&-2 Or (Ty&=>Sb& And Ty&<=Eb&) Clip(W_ix&(Page_id&),W_iy&(Page_id&),W_iw&(Page_id&),W_ih&(Page_id&)) @Wtext(Page_id&,(Ccsizex&+1)*Len(Page$(Ty&)),Ccsizey&+Ty&*Ccsizey&,Chr$(32)) @Pm_line(Ty&) Clip_off Endif Clr Lastl$ ' ' la touche a ‚t‚ d‚clar‚e dans la proc‚dure do_winput: case ... -> exit ' ----------------------------------------------------- ' $S% Select Abs(Reponse%) ' Case 13 ! Enter If Maxty&-Ty&>2 E$=@Defm$(Ty&) ~@Do_winput(Page_id&,-1,-1,-2,Maxstr&,E$) Ty&=Min(Ty&+1,Dims&) Insert Page$(Ty&)="" Gosub Indentage ! rappel d'indentage Inc Maxty& @Page_set Wsetsl(0) ' Do_wkill(Page_id&) E$=@Defm$(Ty&) Do_wkill(Page_id&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,E$) ' Rdw_all(0) Flag!=True ! Red‚ssiner fenˆtre @Showm ' Else ! COPIE DE BAS Reponse%=Dwx_&(Page_id&) E$=@Defm$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,-2,Maxstr&,E$) ' If Len(Page$(Ty))>0 Or Ty0 If Ty&>Maxty&-2 And Ty&+10 Dwx_&(Page_id&)=Min(Reponse%,Len(Page$(Ty&))+1) Else Dwx_&(Page_id&)=0 Endif Else Do_winit(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,@Defm$(Ty&)) @Videkbd2 Endif ' If Modify!=True E$=@Defm$(Ty&) ~@Do_winput(Page_id&,-1,-1,&H0,Maxstr&,E$) ' Endif Endif Case 208 ! bas Reponse%=Dwx_&(Page_id&) E$=@Defm$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,-2,Maxstr&,E$) ' If Len(Page$(Ty))>0 Or Ty0 If Ty&>Maxty&-2 And Ty&+10 Dwx_&(Page_id&)=Min(Reponse%,Len(Page$(Ty&))+1) Else Dwx_&(Page_id&)=0 Endif Else Do_winit(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,@Defm$(Ty&)) @Videkbd2 Endif ' If Modify!=True E$=@Defm$(Ty&) ~@Do_winput(Page_id&,-1,-1,&H0,Maxstr&,E$) ' Endif Case 200 ! haut If Ty&>0 Reponse%=Dwx_&(Page_id&) E$=@Defm$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,-2,Maxstr&,E$) ' ~@Do_winput(Page_id&,-1,-1,-2,Maxstr&,T$) Ty&=Max(Ty&-1,0) Do_wkill(Page_id&) Do_winit(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,@Defm$(Ty&)) If Len(Page$(Ty&))>0 Dwx_&(Page_id&)=Min(Reponse%,Len(Page$(Ty&))+1) Else Dwx_&(Page_id&)=0 Endif ' If Modify!=True E$=@Defm$(Ty&) ~@Do_winput(Page_id&,-1,-1,&H0,Maxstr&,E$) Else @Videkbd2 E$=@Defm$(Ty&) ~@Do_winput(Page_id&,-1,-1,&H0,Maxstr&,E$) Endif ' Endif Case 10,225 ! Undo Do_wkill(Page_id&) If Abs(Reponse%)=225 If Left$(Undo$,1)=Chr$(32) Insert Page$(Ty&)="'"+Undo$ Else Insert Page$(Ty&)="' "+Undo$ Endif Else Insert Page$(Ty&)="" Endif Gosub Indentage ! rappel d'indentage ' Rdw_all(0) Flag!=True ! Red‚ssiner fenˆtre Inc Maxty& @Page_set Wsetsl(0) E$=@Defm$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,E$) Case 1,247 ! ^home Gosub Indentage ! rappel d'indentage Ty&=0 Do_wkill(Page_id&) E$=@Defm$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,E$) ' Rdw_all(0) Flag!=True ! Red‚ssiner fenˆtre ' Case 236 ! Gosub Indentage ! rappel d'indentage Ty&=Maxty&-2 Do_wkill(Page_id&) E$=@Defm$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,E$) ' Rdw_all(0) Flag!=True ! Red‚ssiner fenˆtre ' Case 1208 ! 1xxx=\/ Gosub Indentage ! rappel d'indentage Do_wkill(Page_id&) Ty&=Min(Max(0,Maxty&-2),Ty&+(W_ih&(0)\Ccsizey&)-1) E$=@Defm$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,E$) Case 1200 ! 1xxx=^ Gosub Indentage ! rappel d'indentage Do_wkill(Page_id&) Ty&=Max(0,Ty&-(W_ih&(0)\Ccsizey&)-1) E$=@Defm$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,E$) ' Case 26 Gosub Indentage ! rappel d'indentage Ty&=Maxty&-2 Do_wkill(Page_id&) E$=@Defm$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,E$) ' Rdw_all(0) Flag!=True ! Red‚ssiner fenˆtre Endselect $S% Modify!=False ' Else ! Err syntaxe! ' Beep ~@Infow(Page_id&,Terr$) ' T$=Page$(Ty&) ~@Do_winput(Page_id&,-1,-1,&H0,Maxstr&,T$) @Videkbd ' If Help! Gosub Helpme(Page$(Ty&)) ' Endif ' Endif ! Teste syntaxe ' Else ' If Not Modify! Lastl$=@Defm$(Ty&) Endif If @Defm$(Ty&)<>T$ Modify!=True If Not Edited!(0) Edited!(0)=True @Test_menu ' Gosub Menu_set Endif Page$(Ty&)=T$ Endif ' Endif ! if reponse<0 ' Endif ! if key<>0 ' If Flag! Rdw_all(0) Endif ' Endif ! select key& gal ' If Maxty&<=Ty&+1 ' maxty=nb de lignes+1 Inc Maxty& @Page_set Wsetsl(0) Setxywh(Page_id&,W_ex&(0),W_ey&(0),W_ew&(0),W_eh&(0)) Endif @Showm ' Return Procedure Pm_line(A%) Local Flag! Clr Flag! If A%=>Sb& And A%<=Eb& Flag!=True Endif ' If Len(Page$(A%))>0 If Flag! Gosub Deftext(2,&X10) If Defl&=0 @Wtext(Page_id&,Ccsizex&+Pag_ind&(A%)*Ccsizex&,Ccsizey&+A%*Ccsizey&,Page$(A%)) Else Defl$=Space$(Len(Page$(A%))) ~C:Swmin%(L:V:Page$(A%),L:V:Defl$,W:Len(Page$(A%))) @Wtext(Page_id&,Ccsizex&+Pag_ind&(A%)*Ccsizex&,Ccsizey&+A%*Ccsizey&,Defl$) Endif Gosub Deftext(Col1&,&X0) Else If Defl&=0 @Wtext(Page_id&,Ccsizex&+Pag_ind&(A%)*Ccsizex&,Ccsizey&+A%*Ccsizey&,Page$(A%)) Else Defl$=Space$(Len(Page$(A%))) ~C:Swmin%(L:V:Page$(A%),L:V:Defl$,W:Len(Page$(A%))) @Wtext(Page_id&,Ccsizex&+Pag_ind&(A%)*Ccsizex&,Ccsizey&+A%*Ccsizey&,Defl$) Endif Endif Endif ' Return Procedure Page_set ' Max h dans editeur de texte @Wset_max_h(Page_id&,Max(Maxty&*Ccsizey&,Ccsizey&*12)+Ccsizey&*2) Return ' ' Instr sweetel avec effet deflist Function Defm$(A&) If Len(Page$(A&))>0 If Defl&>0 Defl$=Space$(Len(Page$(A&))) ~C:Swmin%(L:V:Page$(A&),L:V:Defl$,W:Len(Page$(A&))) Return Defl$ Else Return Page$(A&) Endif Else Return "" Endif Endfunc ' Function Xdefm$(E$) If Len(E$)>0 If Defl&>0 Defl$=Space$(Len(E$)) ~C:Swmin%(L:V:E$,L:V:Defl$,W:Len(E$)) Return Defl$ Else Return E$ Endif Else Return "" Endif Endfunc ' ' ' 0=MAJ 1=Min 2=min Procedure Defl(L&) ~C:Swmin%(L:0,L:0,W:L&) ! deflist sweetel Defl&=L& ! nouveau deflist Return ' ' ' Travailler sur l'instruction e$ -> edit Function Instrwork(Var E$) $F% Return @Iclic(E$) Endfunc ' ' ‚dition dynamique souris! - double clic.. Procedure Moused(Mx&,My&) Local T$ ' Mpos(Mx&,My&) If Not Modify! If Len(Page$(Ty&))>0 ' T$=Page$(Ty&) If @Iclic(T$) Page$(Ty&)=T$ Gosub Indentage Rdw_all(0) Else Page$(Ty&)=T$ T$=@Xdefm$(T$) Endif ' ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,T$) Endif Endif ' Return ' ' Clic instrution! Function Iclic(Var E$) $F% Local P&,A& Local Flag! Local A$ ' P&=Instr(Page$(Ty&),Chr$(32)) If P&=0 P&=Len(Page$(Ty&)) Endif ' $S% Select Upper$(Left$(E$,4)) ' Case "ENCR","FOND" A&=@Col8 If A&=>0 E$=Left$(E$,P&)+Col$(0,A&) Endif ' Case "GRAP" E$="TEXTE" ' Case "TEXT" E$="GRAPHIQUE" ' Case "TXT ","TXT" If Len(E$)<=60 A$=@Rinput$("TXT:",Mid$(E$,5)) If Len(A$)>0 E$="TXT "+A$ Endif Modify!=True Else @Beep Endif ' Case "PROC" Clr A$ If Not Modify! A$=@Prinput$(E$) Modify!=True Else If Upper$(Trim$(E$))="PROCEDURE" A$=@Prinput$(E$) Modify!=True Else @Beep Endif Endif If Len(A$)>0 E$=A$ Endif ' Default ' Select Left$(E$,1) Case "{" Mid$(E$,1,1)="}" Return True ' Case "}" Mid$(E$,1,1)="{" Return True ' Case "'" Flag!=False For A&=3 To Len(E$) $S& Select Mid$(E$,A&,1) Case "A" To "Z" If Flag! Mid$(E$,A&,1)=Chr$(Asc(Mid$(E$,A&,1))+32) Else Flag!=True Endif Case "a" To "z" If Not Flag! Mid$(E$,A&,1)=Chr$(Asc(Mid$(E$,A&,1))-32) Flag!=True Endif Endselect $S% Next A& ' Default If Right$(E$,3)=" ON" If Not @Stat(True,Left$(E$,Len(E$)-3)) E$=Left$(E$,Len(E$)-3)+" OFF" Endif Else if Right$(E$,4)=" OFF" If @Stat(False,Left$(E$,Len(E$)-4)) E$=Left$(E$,Len(E$)-4)+" ON" Endif Endif Endselect ' Endselect Return False Endfunc ' ' On/Off? Function Stat(Flag!,E$) $F% Local A& ' Char{Ob_spec(Adr%(34),St_xx&)}=E$+" : " Ob_state(Adr%(34),St_on&)=Bclr(Ob_state(Adr%(34),St_on&),0) Ob_state(Adr%(34),St_off&)=Bclr(Ob_state(Adr%(34),St_off&),0) If Flag! Ob_state(Adr%(34),St_on&)=Bset(Ob_state(Adr%(34),St_on&),0) Else Ob_state(Adr%(34),St_off&)=Bset(Ob_state(Adr%(34),St_off&),0) Endif ' Exdo!=True A&=Byte(@Form_wdo(34,0)) ~@Wind_update01(0) Ob_state(Adr%(34),A&)=Bclr(Ob_state(Adr%(34),A&),0) ' ~form_dial(3,0,0,0,0,Rx&(34),Ry&(34),Rw&(34),Rh&(34)) ~@Form_wdo(34,-3) Exdo!=True @W_rdexe ' $S& Select A& Case St_ok& If Btst(Ob_state(Adr%(34),St_on&),0) Flag!=True Else Flag!=False Endif ' Case St_ann& Endselect $S% ' Return Flag! Endfunc ' Function Prinput$(E$) Local N&,P&,A& Local N$,A$,T$ ' ' PROCEDURE toto(..) E$=Mid$(E$,11) N&=Instr(E$,"(") If N&=0 N$=E$ ! nom Clr E$ ! pas de params Else N$=Left$(E$,N&-1) ! nom E$=Mid$(E$,N&+1) ! params E$=Left$(E$,Len(E$)-1) ! sans la ) Endif ' If Len(N$)=0 N$="PROC_SANS_NOM" Endif ' ' Dim Par_p&(9) ! Params Arrayfill Par_p&(),0 ! pas de params Clr P& ! 0 params pour l'instant ' If Len(E$)>0 Do N&=Instr(E$,",") If N&<>0 A$=Left$(E$,N&-1) E$=Mid$(E$,N&+1) Else A$=E$ Clr E$ Endif ' $S& Select Left$(A$,2) Case "/","ON" Par_p&(P&)=0 Case ".","N6" Par_p&(P&)=1 Case "&","OC" Par_p&(P&)=2 Case "#","RE" Par_p&(P&)=3 Case "$","CH" Par_p&(P&)=4 Case "œ","CO" Par_p&(P&)=5 Default ! ya un'blŠme! @Beep Clr E$ P&=-1 Exit if True Endselect $S% ' Inc P& ! param +1 Loop until Len(E$)=0 Endif ' If P&=>0 ! Ok? ' ' Nom de la procedure: Char{{Ob_spec(Adr%(30),Pa_nom&)}}=Left$(N$,42) If P&=0 ! pas de params For N&=0 To 5 Ob_state(Adr%(30),Pa_t1&+N&)=Bset(Ob_state(Adr%(30),Pa_t1&+N&),3) Next N& Else For N&=0 To 5 Ob_state(Adr%(30),Pa_t1&+N&)=Bclr(Ob_state(Adr%(30),Pa_t1&+N&),3) Next N& Endif Exdo!=True X&=0 ! nø param P&=Min(9,P&) ~@Form_exdo(30,-2) Do ' T$="ParamŠtre "+Str$(X&+1)+" => " $S& Select Par_p&(X&) Case 0 T$=T$+"PAR(" Char{Ob_spec(Adr%(30),Pa_c1&+1)}=" " Char{Ob_spec(Adr%(30),Pa_c1&+2)}="ON -> vaut -1 (TRUE) " Char{Ob_spec(Adr%(30),Pa_c1&+3)}="OFF -> vaut 0 (FALSE) " Case 1 T$=T$+"PAR(" Char{Ob_spec(Adr%(30),Pa_c1&+1)}=" " Char{Ob_spec(Adr%(30),Pa_c1&+2)}="Valeur (1..63) inscrite dans " Char{Ob_spec(Adr%(30),Pa_c1&+3)}="cet ‚l‚ment du tableau " Case 2 T$=T$+"PAR(" Char{Ob_spec(Adr%(30),Pa_c1&+1)}=" " Char{Ob_spec(Adr%(30),Pa_c1&+2)}="Valeur (octet) inscrite dans " Char{Ob_spec(Adr%(30),Pa_c1&+3)}="cet ‚l‚ment du tableau PAR " Case 3 T$=T$+"PAR(" Char{Ob_spec(Adr%(30),Pa_c1&+1)}=" " Char{Ob_spec(Adr%(30),Pa_c1&+2)}="Valeur (r‚‚lle) inscrite dans " Char{Ob_spec(Adr%(30),Pa_c1&+3)}="cet ‚l‚ment du tableau PAR " Case 4 T$=T$+"PAR$(" Char{Ob_spec(Adr%(30),Pa_c1&+1)}=" " Char{Ob_spec(Adr%(30),Pa_c1&+2)}="La chaine alphanum‚rique est " Char{Ob_spec(Adr%(30),Pa_c1&+3)}="inscrite dans cet ‚l‚ment " Case 5 T$=T$+"PAR(" Char{Ob_spec(Adr%(30),Pa_c1&+1)}=" " Char{Ob_spec(Adr%(30),Pa_c1&+2)}="L'index de couleur (0..7) " Char{Ob_spec(Adr%(30),Pa_c1&+3)}="est inscrit ici (0=noir) " Endselect $S% T$=T$+Str$(X&+1)+")" Char{Ob_spec(Adr%(30),Pa_c1&+0)}=T$ ~Objc_draw(Adr%(30),Pa_box2&,255,Rx&(30),Ry&(30),Rw&(30),Rh&(30)) ' Char{{Ob_spec(Adr%(30),Pa_npar&)}}=Str$(X&+1) Char{{Ob_spec(Adr%(30),Pa_maxpar&)}}=Str$(P&) ~Objc_draw(Adr%(30),Pa_npar&,255,Rx&(30),Ry&(30),Rw&(30),Rh&(30)) ~Objc_draw(Adr%(30),Pa_maxpar&,255,Rx&(30),Ry&(30),Rw&(30),Rh&(30)) ' For N&=0 To 5 Ob_state(Adr%(30),Pa_t1&+N&)=Bclr(Ob_state(Adr%(30),Pa_t1&+N&),0) Next N& Ob_state(Adr%(30),Pa_t1&+Par_p&(X&))=Bset(Ob_state(Adr%(30),Pa_t1&+Par_p&(X&)),0) ~Objc_draw(Adr%(30),Pa_box&,255,Rx&(30),Ry&(30),Rw&(30),Rh&(30)) ' A&=Byte(@Form_exdo(30,0)) Ob_state(Adr%(30),A&)=Bclr(Ob_state(Adr%(30),A&),0) ~Objc_draw(Adr%(30),A&,255,Rx&(30),Ry&(30),Rw&(30),Rh&(30)) ' For N&=0 To 5 ! sauver param (type) If Btst(Ob_state(Adr%(30),Pa_t1&+N&),1) Par_p&(X&)=N& Endif Next N& ' Select A& ' Case Pa_np& ! num‚ro param If P&>0 X&=Min(P&-1,X&+1) Endif Case Pa_nm& If P&>0 X&=Max(0,X&-1) Endif ' Case Pa_mp& ! max params If P&=0 For N&=0 To 5 Ob_state(Adr%(30),Pa_t1&+N&)=Bclr(Ob_state(Adr%(30),Pa_t1&+N&),3) Next N& Endif P&=Min(10,P&+1) Case Pa_mm& P&=Max(0,P&-1) If P&>0 X&=Min(P&-1,X&) Else If P&=0 For N&=0 To 5 Ob_state(Adr%(30),Pa_t1&+N&)=Bset(Ob_state(Adr%(30),Pa_t1&+N&),3) Next N& Endif Endif ' Case Pa_t1& To Pa_t10& Par_p&(X&)=A&-Pa_t1& ' Case Pa_ok& A&=-1 Exit if True Case Pa_ann&,0 A&=0 Exit if True Endselect ' Loop ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(30),Ry&(30),Rw&(30),Rh&(30)) ~@Form_exdo(30,-3) Gosub W_rdexe ' Clr E$ E$=Char{{Ob_spec(Adr%(30),Pa_nom&)}} If Len(E$)>0 N$=E$ ! enregistrer nom If Len(N$)=0 ! toujours pas de nom!! N$="PROC_SANS_NOM" ~@Form_alert(1,"[1][|Cette procedure n'a toujours |pas de nom! |][ Not‚ ]") Endif Endif ' Select Left$(N$,1) Case "0" To "9" N$="_"+N$ Endselect ' Clr E$ ! Retour If A&=-1 ! sauver params ' E$="PROCEDURE " If P&=0 ! Proc sans paramŠtres! E$=E$+N$ Else E$=E$+N$+"(" ! Proc AVEC paramŠtres (bah oui c‚mmieu) For N&=0 To P&-1 $S& Select Par_p&(N&) Case 0 E$=E$+"ON/OFF" Case 1 E$=E$+"N63" Case 2 E$=E$+"OCTET" Case 3 E$=E$+"REELLE" Case 4 E$=E$+"CHAINE" Case 5 E$=E$+"COULEUR" Endselect $S% ' If N&0 ! prefs? For A%=0 To 5 ' ' Coords en 1/10000Š Wset_x(A%,(Cvl(Mid$(Lcomm$,A%*36+1,4))*(Work_out(0)+1))\10000) Wset_y(A%,(Cvl(Mid$(Lcomm$,A%*36+1+4,4))*(Work_out(1)+1))\10000) Wset_w(A%,(Cvl(Mid$(Lcomm$,A%*36+1+$ And And And And Eqv Xor ,4))*(Work_out(0)+1))\10000) Wset_h(A%,(Cvl(Mid$(Lcomm$,A%*36+1+12,4))*(Work_out(1)+1))\10000) ' W_fx&(A%)=(Cvl(Mid$(Lcomm$,A%*36+1+$ And And And And Eqv Imp ,4))*(Work_out(0)+1))\10000 W_fy&(A%)=Max(Y_desk&,(Cvl(Mid$(Lcomm$,A%*36+1+$ And And And And Eqv Imp ,4))*(Work_out(1)+1))\10000) W_fw&(A%)=(Cvl(Mid$(Lcomm$,A%*36+1+$ And And And And Eqv Imp ,4))*(Work_out(0)+1))\10000 W_fh&(A%)=(Cvl(Mid$(Lcomm$,A%*36+1+$ And And And And Eqv Imp ,4))*(Work_out(1)+1))\10000 ' If Word(Cvi(Mid$(Lcomm$,A%*36+1+32,2)))=True ! ouverte? ~@Wind_create(A%) ! alors ouvrir! Endif Next A% Else For A%=0 To 5 If A%<>1 W_fx&(A%)=X_desk&+A%*100 W_fy&(A%)=Y_desk& W_fw&(A%)=280 W_fh&(A%)=42 Swap W_fx&(A%),W_ex&(A%) Swap W_fy&(A%),W_ey&(A%) Swap W_fw&(A%),W_ew&(A%) Swap W_fh&(A%),W_eh&(A%) Endif Next A% Endif ' Return 0 Endfunc Procedure Field_max ' ..Remplissage des coordonn‚es XY. Wset_max_w(0,(Maxstr&+4)*Ccsizex&) ! Input page Wset_max_h(0,Ccsizey&*12) ! Wmax_off(0) ! limites ' Wset_max_w(1,Max(W_desk&,80*Ccsizex&)) Wset_max_h(1,$ And And And And Eqv Imp *Ccsizey&) ! Wmax_on(1) ! pas de limites ' Wset_max_w(2,Ccsizex&+322) ! Wset_max_h(2,Ccsizey&+152) ! Wmax_off(2) ! no limites ' Wset_max_w(3,86*Ccsizex&) ! liste Wset_max_h(3,(Toti&+4)*Ccsizey&) ! nb max d'instr Wmax_off(3) ! limites ' Wset_max_w(4,Eccsizex&*82+Emx&) ! ‚mulat Wset_max_h(4,Eccsizey&*32+Emy&) ! Wmax_off(4) ! limites ' Wset_max_w(5,Drs_x&+47*12+16+Drs_x&) ! Editeur Wset_max_h(5,Drs_y&+4*$ And And And And Eqv Xor +16+Drs_y&) ! DRCS Wmax_on(5) ! limites ' Wset_max_w(6,Bitw&) ! Image Wset_max_h(6,Bith&) ! DRCS Wmax_on(6) ! limites ' Wset_max_w(Wdial&,W_desk&) Wset_max_h(Wdial&,H_desk&) Wmax_on(6) ! limites ' Return ' Procedure Draw(Index&,X&,Y&,W&,H&) ! general ' Local A%,X2%,Y2%,B%,C%,D%,E%,Vididx&,Typ& ' Local T$ ' If Set_system&<>2 ! <> NoRedraws @Lhidem Select Index& Case 0 To 5,7 To @Bndary(0) Gosub Deffill(0,1,1) ! Effacer ' Pbox W_ix&(Index&),W_iy&(Index&),W_ix&(Index&)+W_iw&(Index&),W_iy&(Index&)+W_ih&(Index&) ! fenˆtre Gosub Pbox(X&,Y&,X&+W&-1,Y&+H&-1) Endselect Gosub Deffill(Colg&,1,1) Gosub Deftext(Col1&,0) Gosub Deftextattrb(0) Gosub Color(Colg&) @Bndary(1) ' If @Shift<>&X11 ' pas de tache de fond If Set_system&=0 Or (Index&=4 And Redir!) Or (Index&=Nbr_idxw&) Or (Index&=1) ' $S& Select Index& Case 0 Gosub Page_manage(-1) Case 1 Draw_m(X&,Y&,W&,H&) Case 2 Draw_g(X&,Y&,W&,H&) Case 3 Draw_l(X&,Y&,W&,H&) Case 4 ! emul Draw_e(X&,Y&,W&,H&) Case 5 Gosub Drcs_draw(X&,Y&,W&,H&) Case 6 Gosub Bit_draw(X&,Y&,W&,H&) Case Wdial& Draw_wd(X&,Y&,W&,H&) Case Nbr_idxw& ' Gosub Draw_bk(X&,Y&,W&,H&) ~Objc_draw(Adr%(0),0,255,X&,Y&,W&,H&) Graphmode 2 Deftext 1,&X10,0,6 Text Ob_x(Adr%(0),0)+80,Ob_y(Adr%(0),0)+Ob_h(Adr%(0),0)-2,"Version "+Release$+", "+Reldate$ Graphmode 1 Deftext Col1&,0 Set_text&=&H1234 ! desactiv‚ @Sweety_text Endselect $S% ' Else ' Gosub Deffill(1,2,2) Gosub Pbox(W_ix&(Index&),W_iy&(Index&),W_ix&(Index&)+W_iw&(Index&),W_iy&(Index&)+W_ih&(Index&))! fenˆtre Gosub Deffill(Colg&,1,1) Endif @Lshowm ' Else @Lshowm Endif Else Gosub Defmouse(2) Gosub Defmouse(0) Endif ' Return ' Procedure Draw_e(X&,Y&,W&,H&) ! emulat Local A&,X2&,Y2& ' ' @Bndary(1) ' Color Col1& ' Box @Wxacoord(4,Emx&-2),@Wyacoord(4,Emy&-2),@Wxacoord(4,Emx&+(Vmax_x&+1)*Ccsizex&+2),@Wyacoord(4,(Vmax_y&+1)*Ccsizey&+Emy&+2) ' Color Colg& ' Box @Wxacoord(4,Emx&-1),@Wyacoord(4,Emy&-1),@Wxacoord(4,Emx&+(Vmax_x&+1)*Ccsizex&+1),@Wyacoord(4,(Vmax_y&+1)*Ccsizey&+Emy&+1) @Xgbox(@Wxacoord(4,Emx&),@Wyacoord(4,Emy&),@Wxacoord(4,Emx&+(Vmax_x&+1)*Eccsizex&),@Wyacoord(4,(Vmax_y&+1)*Eccsizey&+Emy&)) ' If Emulm|=0 ! mode vid‚otex Gosub Deffill(Fcol&(0),Fstyl|(0),Findex|(0)) Gosub Pbox(@Wxacoord(4,Emx&),@Wyacoord(4,Emy&),@Wxacoord(4,Emx&+(Vmax_x&+1)*Eccsizex&),@Wyacoord(4,(Vmax_y&+1)*Eccsizey&+Emy&)) ' Gosub Sweety_text Gosub Eminfo("") ' If W&>0 And H&>0 X&=@Wxrcoord(4,X&-Emx&) Y&=@Wyrcoord(4,Y&-Emy&) If X&<0 Add W&,X& Clr X& Endif If Y&<0 Add H&,Emy& Clr Y& Endif Gosub Emuledraw(X&,Y&,W&,H&) ' If Set_minid! X2&=@Wxacoord(4,Emx&) Y2&=@Wyacoord(4,Emy&) @Emul_text(0) Gosub Deftext(1,0) Gosub Deffill(1,1,1) @Bndary(0) For A&=1 To Len(Minid$) Step 8 X&=Cvi(Mid$(Minid$,A&,2)) Y&=Cvi(Mid$(Minid$,A&+2,2)) W&=Cvi(Mid$(Minid$,A&+4,2)) H&=Cvi(Mid$(Minid$,A&+6,2)) ' Binair$(Actb&)=Binair$(Actb&)+@Miniblock$(X&,Y&,w&,h&) If Segi! Graphmode (3) Endif Gosub Pbox(X2&+X&*Eccsizex&+1,Y2&+Y&*Eccsizey&+1,X2&+(X&+W&)*Eccsizex&-1,Y2&+(Y&+H&)*Eccsizey&-1) Graphmode (1) If Segn! If W&>2 Text X2&+X&*Eccsizex&,Y2&+Y&*Eccsizey&+Decalt&(0),Str$((A&-1)\8+1) Else Text X2&+X&*Eccsizex&,Y2&+Y&*Eccsizey&+Decalt&(0),Right$(Str$((A&-1)\8+$ And And And And Imp ô$W&) Endif Endif Next A& @Bndary(1) @Sweety_text Gosub Deffill(Colg&,1,1) Gosub Deftext(Col1&,0) Endif Endif ' Return Procedure Draw_g(X&,Y&,W&,H&) ! graph Local X2%,Y2%,A%,B%,C%,D%,E% Local T$ ' If Dim?(Blt$())<>0 X2%=@Wxacoord(2,0) Y2%=@Wyacoord(2,0) ' ' Color 3 ' Box X2%,Y2%,X2%+324,Y2%+154 @Xgbox(X2%-2,Y2%-2,X2%+324,Y2%+154) Gosub Color(Colg&) ' Line X2%+330,Y2%+0,X2%+330,Y2%+200 ' Line X2%+331,Y2%+0,X2%+331,Y2%+200 ' Line X2%+333,Y2%+0,X2%+333,Y2%+200 ' ' Mog_chg ' A%=Ccsizey& B%=3*A% ' Lp_draw!=False ! la loupe est effac‚e Let C%=Max(0,(@Wxrcoord(2,X&)-2)\8) Let D%=Max(0,(@Wyrcoord(2,Y&)-2)\6) ' If C%<39 And D%<39 ' W&=Min(39,(W&\8)+C%-1) H&=Min(Min(24,((H&-1)\6)+D%-1),(H_desk&-W_iy&(2))\6) ' If H&>0 And W&>0 ' ' quels points sont en plus grand nombre? Void Fre(0) ' ~Fre() ' Rout1%=Varptr(Rbn$) E%=Varptr(Vid$) ' $S& Select C:Rbn%(L:E%) Case -1 Gosub Deffillcol(Colg&) ! pr‚d‚fini fond plein ' pour le grillage: c super, ya rien … faire!! Typ&=True Gosub Pbox(X2%+2,Y2%+2,X2%+321,Y2%+151) Case 0 Gosub Deffillcol(0) ! fond vide Typ&=False Gosub Pbox(X2%+2,Y2%+2,X2%+321,Y2%+151) ' grillage Select Grill| Case 0 Case 1 For A%=0 To 40 Gosub Line(X2%+2+8*A%,Y2%+2,X2%+2+8*A%,Y2%+151) Next A% For A%=0 To 25 Gosub Line(X2%+2,Y2%+2+A%*6,X2%+321,Y2%+2+A%*6) Next A% Case 2 For A%=0 To 80 Gosub Line(X2%+2+4*A%,Y2%+2,X2%+2+4*A%,Y2%+151) Next A% For A%=0 To 75 Gosub Line(X2%+2,Y2%+2+A%*2,X2%+321,Y2%+2+A%*2) Next A% Endselect Endselect $S% ' ' 320*150 0-0->329-159 Gosub Deffillcol(Colg&) Bndary(0) T$=Space$(40) Void Fre(0) For Y&=D% To H& ' T$=Mid$(Vid$,Y&*40+1,40) Void Fre(0) ' ~Fre() ' Rout1%=Varptr(R40cl$) ' Rout2%=Varptr(R40st$) E%=Varptr(T$) ' teste si t$<>chr$(63)*... If C:R40st%(L:E%)=False If Typ&=0 ! fond non colori‚? Gosub Pbox(X2%+2,Y2%+Y&*6+2,X2%+322,Y2%+Y&*6+7) Endif ' ' teste si t$<>chr$(0)*... Else if C:R40cl%(L:Varptr(T$))=True For X&=C% To W& Vididx&=Asc(Mid$(T$,X&+1,1)) If Typ&=0 If Vididx&>0 @Putp(X2%+X&*8+$ And And And And Eqv And ,Y2%+Y&*6+2,Vididx&) Endif ' Else If Vididx&<63 @Putp(X2%+X&*8+2,Y2%+Y&*6+2,Vididx&) Endif Endif ' Next X& Else If Typ&=True Gosub Deffillcol(0) Gosub Pbox(X2%+2,Y2%+Y&*6+2,X2%+322,Y2%+Y&*6+7) ' ' grillage - eh oui faut le faire!! ' $S& Select Grill| Case 0 Case 1 For A%=0 To 40 Gosub Line(X2%+2+8*A%,Y2%+2+Y&*6,X2%+2+8*A%,Y2%+9+Y&*6) Next A% For A%=0 To 1 Gosub Line(X2%+2,Y2%+2+Y&*6+A%*6,X2%+321,Y2%+2+Y&*6+A%*6) Next A% Case 2 For A%=0 To 80 Gosub Line(X2%+2+$ And And And And Eqv Or *A%,Y2%+2+Y&*6,X2%+2+4*A%,Y2%+9+Y&*6) Next A% For A%=0 To 3 Gosub Line(X2%+2,Y2%+2+Y&*6+A%*2,X2%+321,Y2%+2+Y&*6+A%*2) Next A% Endselect $S% Gosub Deffillcol(Colg&) Endif Endif ' Next Y& ' Bndary(1) Endif Endif ' Endif ! test blt$ Return Procedure Draw_m(X&,Y&,W&,H&) ! menu Local A%,B%,C%,D%,E% ' ' Box @Wxacoord(1,3),@Wyacoord(1,5),@Wxacoord(1,Ccsizex&*80),@Wyacoord(1,3+Ccsizey&*(Compi&+2)) ' Box @Wxacoord(1,0),@Wyacoord(1,2),@Wxacoord(1,Ccsizex&*80),@Wyacoord(1,6+Ccsizey&*(Compi&+2)) ' Box @Wxacoord(1,2),@Wyacoord(1,4),@Wxacoord(1,Ccsizex&*80),@Wyacoord(1,4+Ccsizey&*(Compi&+2)) ' @Xgbox(@Wxacoord(1,8),@Wyacoord(1,8),@Wxacoord(1,Ccsizex&*80),@Wyacoord(1,4+Ccsizey&*(Compi&+2))) ' Gosub Graphmode(2) @Wtext(1,16,Ccsizey&,"Messages:") @Wtext(1,8+Ccsizex&*40,Ccsizey&,"De:") @Wtext(1,$ And And And And Eqv Xor +Ccsizex&*60,Ccsizey&,"Heure:") For A%=0 To Compi& $S& Select Left$(Compinf$(A%),1) Case "*" ! gras/italique Gosub Deftextattrb(&X1) @Wtext(1,10,(A%+3)*Ccsizey&,Mid$(Compinf$(A%),2)) Gosub Deftextattrb(&H0) Default @Wtext(1,10,(A%+3)*Ccsizey&,Compinf$(A%)) Endselect $S% ' Gosub Graphmode(2) Next A% ' Return Procedure Draw_l(X&,Y&,W&,H&) ! liste Local X2%,Y2%,A%,B%,B&,C& Local T$ ' If Dim?(Instr$()) If Not Hl! ' maxi: instr max ' position du slider: position de l'instructions ' instr(): index instructions rang‚s dans l'ordre A%=Ccsizey& B%=0 X2%=@Wyrcoord(3,W_iy&(3)) X2%=Min(Toti&-2,Max(0,(X2%-Ccsizey&)\Ccsizey&)) Y2%=Min(Toti&+3,Max(X2%+1,X2%+(W_ih&(3)\Ccsizey&)+2)) ' For A%=X2% To Y2% ' @Wtext(3,Ccsizex&,B%,Instr$(Instr&(A%),0)) If A%0 Gosub Deftextcol(1) @Wtext(3,Ccsizex&,A%*Ccsizey&,@Qlhelp$(Lst&(A%),1)) Gosub Deftextcol(4) @Wtext(3,Ccsizex&*20,A%*Ccsizey&,@Qlhelp$(Lst&(A%),2)) ' deftext 8 ' @Wtext(3,Ccsizex&,A%*Ccsizey&,@Qlhelp$(lst(A%),3)) Else if Lst&(A%)<>-1 @Wtext(3,Ccsizex&,A%*Ccsizey&,"o "+@Xlst$(Lst&(A%))) Endif Else If A%=Toti&+3 @Wtext(3,Ccsizex&,A%*Ccsizey&,Name$+" "+Release$+" ½1995 - Nombre d'instructions: "+Str$(Maxi&)) ' Else if A%=Toti&+4 ' @Wtext(3,Ccsizex&,A%*Ccsizey&," Aide: "+Str$(Toti&)+" fiches, ½1995") Endif Endif Next A% Gosub Deftextcol(1) ' Else ' For A%=1 To 80 ! line0=nom instruction Gosub Deftext(1,0) T$=Pageh$(A%) B&=Instr(T$,"œ") If B&=0 @Wtext(3,Ccsizex&,(A%+1)*Ccsizey&,Pageh$(A%)) Else Exit if Mid$(T$,B&+1,1)="*" ! EXIT B%=1 If B&>1 B&=0 Endif While B&0 If Mid$(Pageh$(A%),B&,1)="œ" $S& Select Mid$(Pageh$(A%),B&+1,1) Case "_" Gosub Deftextattrb(&X1000) Case "g" Gosub Deftextattrb(&X1) Case "G" Gosub Deftextattrb(&X1001) Case "L" Gosub Deftextattrb(&X10) Case "i" Gosub Deftextattrb(&X100) Case "I" Gosub Deftextattrb(&X1100) Case "b" Gosub Deftextattrb(&X10000) Case "B" Gosub Deftextattrb(&X10001) Case "-" Gosub Deftextattrb(0) Case " " ! faux espace Inc B% Default Gosub Deftextcol(Asc(Mid$(Pageh$(A%),B&+1,1))-48) Endselect $S% Endif @Wtext(3,Ccsizex&*B%,(A%+1)*Ccsizey&,Mid$(Pageh$(A%),B&+2,C&-B&-2)) Add B%,C&-B&-2 Else @Wtext(3,Ccsizex&*B%,(A%+1)*Ccsizey&,Mid$(Pageh$(A%),B&+1,C&-1)) Add B%,C&-1 Endif B&=C& Wend Endif Next A% Gosub Deftext(1,0) ' Endif ! dimS? Endif ' Return Procedure Draw_bk(X&,Y&,W&,H&) ! back, logo Local A&,L& Local Rx&,Ry&,Rw&,Rh& Local W2& ' H2&=Ob_h(Adr%(0),1) ' ' Print Ob_h(Adr%(0),0) 96 Select Work_out(13) Case 16,256 Clr L& For A&=0 To Work_out(13)-2 Rx&=Ob_x(Adr%(0),0) Ry&=Ob_y(Adr%(0),0)+(H2&*A&)\(Work_out(13)-1) Rw&=Ob_w(Adr%(0),0) Rh&=((H2&*(A&+1))\(Work_out(13)-1))-((H2&*A&)\(Work_out(13)-1)) If Rc_intersect(X&,Y&,W&,H&,Rx&,Ry&,Rw&,Rh&) ' Ob_spec(Adr%(0),1)=Or(And(Ob_spec(Adr%(0),0),&HFFFFFF00),(&X11110000 Or (A&+1))) ' Word{Ob_spec(Adr%(0),1)+12}=A&+1 ~Objc_draw(Adr%(0),0,255,Rx&,Ry&,Rw&,Rh&) Endif Next A& Default ~Objc_draw(Adr%(0),0,255,X&,Y&,W&,H&) Endselect ' Graphmode 2 Deftext 1,&X10,0,6 Text Ob_x(Adr%(0),0)+80,Ob_y(Adr%(0),0)+H2&-2,"Version "+Release$+", "+Reldate$ Graphmode 1 Deftext Col1&,0 Set_text&=&H1234 ! desactiv‚ @Sweety_text ' Return ' ' proc redraw dialer Procedure Draw_wd(X&,Y&,W&,H&) Ob_x(Adr%(Wd_id&),0)=@Wxacoord(Wdial&,0) Ob_y(Adr%(Wd_id&),0)=@Wyacoord(Wdial&,0) ~Objc_draw(Adr%(Wd_id&),0,0,X&,Y&,W&,H&) Ob_y(Adr%(Wd_id&),0)=@Wyacoord(Wdial&,-Wd_incy&) ~Objc_draw(Adr%(Wd_id&),0,7,X&,Y&,W&,H&) ' Rx&(Wd_id&)=Ob_x(Adr%(Wd_id&),0) Ry&(Wd_id&)=Ob_y(Adr%(Wd_id&),0) Return ' Procedure Sm_draw(Index&,X&,Y&,W&,H&) ! smalled Gosub Deffillcol(0) Gosub Pbox(W_ix&(Index&),W_iy&(Index&),W_ix&(Index&)+W_iw&(Index&),W_iy&(Index&)+W_ih&(Index&)) ! fenˆtre Ob_x(Adr%(31),0)=W_ix&(Index&) Ob_y(Adr%(31),0)=W_iy&(Index&) ~Objc_draw(Adr%(31),0,255,X&,Y&,W&,H&) Gosub Deffillcol(1) Return ' Procedure Drawx(Index&) ' $S& Select Index& Case 0 If Dim?(Dwx_&()) If Maxty&Dims&-2 ~@Infow(Index&,"Il n'y a plus de lignes libres dans l'‚diteur!") Else If Capt|=1 Gosub Menu.info("Attente.. octets captur‚s: "+Str$(Len(Binair$(Captb&)))) Else if Capt|=2 Gosub Menu.info("Attente de fin de page.. octets captur‚s: "+Str$(Len(Binair$(Captb&)))) Else ~@Infow(Index&,"Rien … signaler. "+Time$+Chr$(32)+Date$) Menu_time!=True Endif Endif Case 2 ~@Infow(Index&,"Clic G: Dessiner, Clic D: MENU") Case 4 ' ~@Infow(Index&,"Clic D: Touches de fonction") Emstat Endselect $S% ' Return Procedure Drawt(Index&) Select Index& Case 0 ~@Titlew(0,"Vid‚otex, ‚diteur - "+File$(0)+" ["+Name$+"]") Endselect Return ' Procedure Rdw_all(Index&) Gosub Rd_all(Index&,W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) Return ' ' ' Procedure Wbtext(Index&,X&,Y&,T$) Local L%,X2%,Y2% ' @Lhidem ' "Deftail(Font_tail&) ! SWEETEL X2%=@Wxacoord(Index&,X&) L%=1 If X2%<-Ccsizey& L%=-X2%\Ccsizex& Add X2%,L%*Ccsizex& Inc L% Endif Y2%=@Wyacoord(Index&,Y&) Justext(X2%,Y2%,Mid$(T$,L%)) ' Box X2%,Y2%,X2%+Len(T$)*Ccsizex&,Y2%+Ccsizey& ' Box X2%+1,Y2%+1,X2%+Len(T$)*Ccsizex&+1,Y2%+Ccsizey&+1 @Lshowm ' Get_csize Return ' ' ' Cr‚er un menu window Procedure Inimnu Local A%,B%,A$ ' ' Restore Mnu ' Dim Keys&(50) ' Clr B%,A% ' ' Do ' Read B% ' Exit if B%=-1 ' Keys&(A%)=B% ' Inc A% ' Loop ' ' Dim Men_w$(40) ' Restore Menu_w ' Clr A% ' Do ' Read A$ ' Men_w$(A%)=A$ ' Exit if A$="-1" ' Inc A% ' Loop ' Return ' Procedure Closmnu ' Erase Keys&(),Keyg&(),Men_w$() ' Return ' Procedure Menu_open Menu_adr%=Adr%(Menu&) Menu_id&=10 ' ~Menu_bar(Menu_adr%,1) Menu_create ' Gosub Menu_set ! checkings ' Return Procedure Menu_create Local A& ' If Menu_adr%>0 ' ' Copier titre (mais pas W!) Char{Ob_spec(Menu_adr%,M_title&)}=Char{Ob_spec(Adr%(Menu_id&),M_newtitle&)} ' ' Effacer entr‚es, fixer W, fixer ob_next (n‚cessaire car 1 ob_next est effac‚ … chaque fois) For A&=M_first& To M_last& Char{Ob_spec(Menu_adr%,A&)}="" Ob_w(Menu_adr%,A&)=Ob_w(Adr%(Menu_id&),A&-M_first&+M_ed_a_f&) Ob_flags(Menu_adr%,A&)=Bclr(Ob_flags(Menu_adr%,A&),5) If A&0 ~Menu_bar(Menu_adr%,0) Endif Return Procedure Add_menu(Ha&) Local A& ' A&=10 $S& Select Ha& Case 0 A&=11 Case 2 A&=12 Case 4 A&=13 Case 5 A&=14 Case 6 A&=44 Endselect $S% ' If Menu_last&<>A& Menu_last&=A& ' If A&=140 ' A&=14 ' Endif Menu_id&=A& ' Menu_adr%=Adr%(A&) Gosub Menu_create If Menu_id&=13 Set_col(True) Else Set_col(False) Endif Endif ' Return ' Hide etc Procedure Test_menu Local A&,B& Local I& ' If Menu_adr%>0 I&=M_first&-M_ed_a_f& ' If Dim?(Edited!()) And Dim?(Page$()) ' If Len(File$(0))>0 If Edited!(0) ~Menu_ienable(Menu_adr%,M_c_s&,1) ~Menu_ienable(Menu_adr%,M_c_s2&,1) ~Menu_ienable(Menu_adr%,M_sf2&,1) Else ~Menu_ienable(Menu_adr%,M_c_s&,0) ~Menu_ienable(Menu_adr%,M_c_s2&,0) ~Menu_ienable(Menu_adr%,M_sf2&,0) Endif Else ~Menu_ienable(Menu_adr%,M_c_s2&,0) If Edited!(0) ~Menu_ienable(Menu_adr%,M_c_s&,1) ~Menu_ienable(Menu_adr%,M_sf2&,1) Else ~Menu_ienable(Menu_adr%,M_c_s&,0) ~Menu_ienable(Menu_adr%,M_sf2&,0) Endif Endif ' If Maxty&<=2 And Len(Page$(0))=0 And Len(Page$(1))=0 ~Menu_ienable(Menu_adr%,M_f1&,0) ~Menu_ienable(Menu_adr%,M_f10&,0) ~Menu_ienable(Menu_adr%,M_c_a&,0) ' ~Menu_ienable(Menu_adr%,M_c_s&,0) ~Menu_ienable(Menu_adr%,M_c_s2&,0) ~Menu_ienable(Menu_adr%,M_sf2&,0) ' Else ~Menu_ienable(Menu_adr%,M_f1&,1) ~Menu_ienable(Menu_adr%,M_f10&,1) ~Menu_ienable(Menu_adr%,M_c_a&,1) Endif ' A&=-1 Do Inc A& Loop until Len(Binair$(A&))>0 Or A&=>5 If Len(Binair$(A&))>0 ~Menu_ienable(Menu_adr%,M_f6&,1) Else ~Menu_ienable(Menu_adr%,M_f6&,0) Endif ' If Len(Binair$(Actb&))>0 ~Menu_ienable(Menu_adr%,M_f2&,1) ~Menu_ienable(Menu_adr%,M_f9&,1) ~Menu_ienable(Menu_adr%,M_f4&,1) Else ~Menu_ienable(Menu_adr%,M_f2&,0) ~Menu_ienable(Menu_adr%,M_f9&,0) ~Menu_ienable(Menu_adr%,M_f4&,0) Endif ' If Menu_id&=Mnu_drcs& If Drcs! ~Menu_icheck(Menu_adr%,Dr_capt&+I&,1) Else ~Menu_icheck(Menu_adr%,Dr_capt&+I&,0) Endif Else if Menu_id&=Mnu_editi& If Sb&<>-1 And Eb&<>-1 ~Menu_ienable(Menu_adr%,M_ed_c_v&+I&,1) ~Menu_ienable(Menu_adr%,M_ed_c_dl&+I&,1) ~Menu_ienable(Menu_adr%,M_ed_c_ch&+I&,1) Else ~Menu_ienable(Menu_adr%,M_ed_c_v&+I&,0) ~Menu_ienable(Menu_adr%,M_ed_c_dl&+I&,0) ~Menu_ienable(Menu_adr%,M_ed_c_ch&+I&,0) Endif If Len(Find$)>0 ~Menu_ienable(Menu_adr%,M_ed_a_n&+I&,1) Else ~Menu_ienable(Menu_adr%,M_ed_a_n&+I&,0) Endif Else if Menu_id&=Mnu_emul& If Len(Col$)>0 ~Menu_icheck(Menu_adr%,M_em_vdi&+I&,1) Else ~Menu_icheck(Menu_adr%,M_em_vdi&+I&,0) Endif Else if Menu_id&=Mnu_bit& If Bitmap%<=0 ~Menu_ienable(Menu_adr%,Bt_ifx&+I&,0) ~Menu_ienable(Menu_adr%,Bt_clr&+I&,0) ~Menu_ienable(Menu_adr%,Bt_last&+I&,0) Else ~Menu_ienable(Menu_adr%,Bt_ifx&+I&,1) ~Menu_ienable(Menu_adr%,Bt_clr&+I&,1) ~Menu_ienable(Menu_adr%,Bt_last&+I&,1) Endif Endif ' ~Menu_icheck(Menu_adr%,M_c_g&,0) ~Menu_icheck(Menu_adr%,M_c_d&,0) ~Menu_icheck(Menu_adr%,M_c_t&,0) ~Menu_icheck(Menu_adr%,M_c_r&,0) ~Menu_icheck(Menu_adr%,M_c_o&,0) ~Menu_ienable(Menu_adr%,M_c_f2&,1) ~Menu_ienable(Menu_adr%,M_c_f&,1) ~Menu_ienable(Menu_adr%,M_icn&,1) ~Menu_ienable(Menu_adr%,M_c_k&,1) ~Menu_ienable(Menu_adr%,M_ranger&,1) A&=@Firstw Select A& Case 2 ~Menu_icheck(Menu_adr%,M_c_g&,1) Case 0 ~Menu_icheck(Menu_adr%,M_c_d&,1) Case 4 ~Menu_icheck(Menu_adr%,M_c_t&,1) Case 5 ~Menu_icheck(Menu_adr%,M_c_r&,1) ' Case 3 ~Menu_icheck(Menu_adr%,M_c_o&,1) Case 6 Case -1,Nbr_idxw& ~Menu_ienable(Menu_adr%,M_c_f2&,0) ! p ‚cran ~Menu_ienable(Menu_adr%,M_c_f&,0) ! fuller Select @Xfirstw Case -1,Nbr_idxw& ~Menu_ienable(Menu_adr%,M_ranger&,0) ! ranger ~Menu_ienable(Menu_adr%,M_c_k&,0) ! fermer ~Menu_ienable(Menu_adr%,M_icn&,0) Endselect A&=-1 Endselect If A&<>-1 If Btst(Wxflag%(A&),2) ! fullscreen ~Menu_icheck(Menu_adr%,M_c_f2&,1) Else ~Menu_icheck(Menu_adr%,M_c_f2&,0) Endif ' fuller If W_ex&(A&)=X_desk& And W_ey&(A&)=Y_desk& And W_ew&(A&)=W_desk& And W_eh&(A&)=H_desk& ~Menu_icheck(Menu_adr%,M_c_f&,1) Else ~Menu_icheck(Menu_adr%,M_c_f&,0) Endif Endif ' A&=0 Do Exit if Not Wopen!(A&) Inc A& Loop until A&=>Nbr_idxw& If A&=Nbr_idxw& ~Menu_icheck(Menu_adr%,M_c_w&,1) Else ~Menu_icheck(Menu_adr%,M_c_w&,0) Endif ' Clr B& For A&=0 To Nbr_idxw&-1-1 If @Tstwork(A&) Inc B& Endif Next A& If B&<=1 ~Menu_ienable(Menu_adr%,M_c_n&,0) ! suivante Else if B&>0 ~Menu_ienable(Menu_adr%,M_c_n&,1) ! suivante Endif ' Endif Endif Return ' ' Procedure Ld.cnf Local E$ ' If Dim?(Modem$())=0 Dim Modem$(6) Endif E$="MODEM.SET" If @Fexist(E$) Open "i",#1,E$ Line input #1,Modem$(0) ! init If Not Eof(#1) Line input #1,Modem$(1) ! exit If Not Eof(#1) Line input #1,Modem$(2) ! connect If Not Eof(#1) Line input #1,Modem$(3) ! deconnect If Not Eof(#1) Line input #1,Modem$(4) ! ligne ATD If Not Eof(#1) Line input #1,Modem$(5) ! lib‚ration +++ ATH If Not Eof(#1) Line input #1,Modem$(6) ! Endif Endif Endif Endif Endif Endif Close #1 Endif ' ' ' 'Clr Mcl$ E$="SWEETEL2.CNF" If @Fexist(E$) Open "I",#1,E$ Gosub Defmouse(2) If Lof(#1)>8 ! non vide? If Input$(8,#1)="SWXXI211" Speed&=Word(Cvi(Input$(2,#1))) Set_speed!=(Inp(#1)<>0) Ascii&=Inp(#1) Expert!=(Inp(#1)<>0) Acc!=(Inp(#1)<>0) Slow!=(Inp(#1)<>0) Effect!=(Inp(#1)<>0) Autosend!=(Inp(#1)<>0) Efdesk!=(Inp(#1)<>0) Col1&=Word(Cvi(Input$(2,#1))) Colg&=Word(Cvi(Input$(2,#1))) Set_multi!=(Inp(#1)<>0) Set_mtime%=Word(Cvi(Input$(2,#1))) Font&=Word(Cvi(Input$(2,#1))) Font_tail&=Word(Cvi(Input$(2,#1))) ' Efont&=Word(Cvi(Input$(2,#1))) ' Vdt_tail&=Word(Cvi(Input$(2,#1))) Dims&=Cvl(Input$(4,#1)) If Linea! ! si non interdit! Linea!=(Inp(#1)<>0) Endif Segn!=(Inp(#1)<>0) Segi!=(Inp(#1)<>0) Defl&=Inp&(#1) Recept!=(Inp(#1)<>0) Emul!=(Inp(#1)<>0) ' ' Macros? - nan a plus!! ' 'Mcl$=Input$(Word(Cvi(Input$(2,#1))),#1) ' Lp_px&=Word(Cvi(Input$(2,#1))) Lp_py&=Word(Cvi(Input$(2,#1))) Lp_mx&=Word(Cvi(Input$(2,#1))) Lp_my&=Word(Cvi(Input$(2,#1))) Lp_zx&=Word(Cvi(Input$(2,#1))) Lp_zy&=Word(Cvi(Input$(2,#1))) ' Emx&=Word(Cvi(Input$(2,#1))) Emy&=Word(Cvi(Input$(2,#1))) Drs_x&=Word(Cvi(Input$(2,#1))) Drs_y&=Word(Cvi(Input$(2,#1))) ' Lcomm$=Input$(216,#1) ' E$=Input$(Cvi(Input$(2,#1)),#1) ! PARX, void cf ld.parx ' Endif Endif Close #1 Gosub Defmouse(0) Endif ' If Len(Mcl$)=0 ' Mcl$="AUTO.MCS" ' Endif ' Ina$="\SWEETEL2.INA" ! aide pour les instructions If Not @Exist(Ina$) Ina$="SWEETEL2.INA" ! aide pour les instructions Endif ' Gosub Ld.parx ' Return Procedure Sv.cnf Local A% ' Gosub Fmshow("Sauvegarde de la configuration ..") ' "Deftail(Font_tail&) Gosub Emul_text(0) Contrl(0)=38 ! Inquire Current Graphic Text Attributes Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys Vdt_tail&=Ptsout(1) ! Taille fonte texte Gosub Sweety_text Contrl(0)=38 ! Inquire Current Graphic Text Attributes Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys Font_tail&=Ptsout(1) ! Taille fonte texte ' ~@Wind_update01(0) Gosub Defmouse(2) Open "O",#1,Set_path$+"SWEETEL2.CNF" Print #1,"SWXXI211"; Print #1,Mki$(Speed&); Print #1,Chr$(Set_speed!); Print #1,Chr$(Ascii&); Print #1,Chr$(Expert!); Print #1,Chr$(Acc!); Print #1,Chr$(Slow!); Print #1,Chr$(Effect!); Print #1,Chr$(Autosend!); Print #1,Chr$(Efdesk!); Print #1,Mki$(Col1&); Print #1,Mki$(Colg&); Print #1,Chr$(Set_multi!); Print #1,Mki$(Set_mtime%); Print #1,Mki$(Font&); Print #1,Mki$(Font_tail&); ' Print #1,Mki$(Efont&); ' Print #1,Mki$(Vdt_tail&); Print #1,Mkl$(Dims&); Print #1,Chr$(Linea!); Print #1,Chr$(Segn!); Print #1,Chr$(Segi!); Print #1,Mki$(Defl&); Print #1,Chr$(Recept!); Print #1,Chr$(Emul!); ' ' If Len(File$(6))>0 ' Select Left$(File$(6),1) ' Case "\" ' Mcl$=Chr$(Gemdos(25)+65)+":"+File$(6) ' Default ' Mcl$=File$(6) ' Endselect ' Endif ' 'Print #1,Mki$(Len(Mcl$))+Mcl$; ' Print #1,Mki$(Lp_px&); Print #1,Mki$(Lp_py&); Print #1,Mki$(Lp_mx&); Print #1,Mki$(Lp_my&); Print #1,Mki$(Lp_zx&); Print #1,Mki$(Lp_zy&); ' Print #1,Mki$(Emx&); Print #1,Mki$(Emy&); Print #1,Mki$(Drs_x&); Print #1,Mki$(Drs_y&); ' For A%=0 To 5 Print #1,Mkl$((W_ex&(A%)*10000)\(Work_out(0)+1)); Print #1,Mkl$((W_ey&(A%)*10000)\(Work_out(1)+1)); Print #1,Mkl$((W_ew&(A%)*10000)\(Work_out(0)+1)); Print #1,Mkl$((W_eh&(A%)*10000)\(Work_out(1)+1)); Print #1,Mkl$((W_fx&(A%)*10000)\(Work_out(0)+1)); Print #1,Mkl$((W_fy&(A%)*10000)\(Work_out(1)+1)); Print #1,Mkl$((W_fw&(A%)*10000)\(Work_out(0)+1)); Print #1,Mkl$((W_fh&(A%)*10000)\(Work_out(1)+1)); ' Print #1,Mki$(Wopen!(A%)); Print #1,Mki$(@Tstwork(A%)); Next A% ' Print #1,Mki$(0); ! dummy cf sv.parx ' Close #1 Gosub Defmouse(0) Gosub Fmhide Return ' ' Options desselect Procedure Rselect(X%,Flag!) If Flag! ~Objc_change(Adr%(1),X%,0,Rx&(1),Ry&(1),Rw&(1),Rh&(1),Bset(Ob_state(Adr%(1),X%),0),0) Else ~Objc_change(Adr%(1),X%,0,Rx&(1),Ry&(1),Rw&(1),Rh&(1),Bclr(Ob_state(Adr%(1),X%),0),0) Endif Return ' Procedure Rsrc_load Local A%,E$ Local X&,Y& ' If @Exist("SWEETEL2.RSC") A%=Rsrc_load("SWEETEL2.RSC") Else If @Exist("SWEETELV.RSC") ! autre version? (VGA) A%=Rsrc_load("SWEETELV.RSC") Else If @Exist("\SWEETEL2.RSC") ! autre version? A%=Rsrc_load("\SWEETEL2.RSC") Else If @Exist("\SWEETELV.RSC") ! autre version? A%=Rsrc_load("\SWEETELV.RSC") Else If @Form_alert(1,"[1][|Le fichier SWEETEL2.RSC |est introuvable! |][ Chercher | Gasp ]")=1 E$=@Fsel$("\SWEETEL2.RSC","SWEETEL2.RSC","Chercher ReSsourCe") If @Exist(E$) A%=Rsrc_load(E$) Else A%=-33 Endif Else A%=-33 Endif Endif Endif Endif Endif ' If A%<=0 If A%=-33 ~@Form_alert(1,@Errf$(-33)) Else ~@Form_alert(1,"[1][|ProblŠmes de chargement.. |][ Quitter ]") Endif Gosub Uninit On error gosub Eop Edit Endif ' Tree&=44 ! nombre d'arbres d'objets Dim Adr%(Tree&),Rx&(Tree&),Ry&(Tree&),Rw&(Tree&),Rh&(Tree&) For A%=0 To Tree& ~Rsrc_gaddr(0,A%,Adr%(A%)) ! objet 0 400*140 (en fait 128) (imposer) Next A% Ob_w(Adr%(0),1)=496 Ob_h(Adr%(0),1)=96 Ob_x(Adr%(0),1)=0 Ob_y(Adr%(0),1)=0 Ob_w(Adr%(0),0)=496 Ob_h(Adr%(0),0)=96 ' For A%=0 To Tree& If (A%>14 Or A%<10) And A%<>$ And And And And Eqv Eqv And A%<>44 ~Form_center(Adr%(A%),Rx&(A%),Ry&(A%),Rw&(A%),Rh&(A%)) Endif Next A% ' X&=Rw&(28)-Ob_w(Adr%(28),0) Y&=Rh&(28)-Ob_h(Adr%(28),0) Ob_y(Adr%(28),0)=H_desk&+Y_desk&-Rh&(28)+X&\2-1 Ry&(28)=H_desk&+Y_desk&-Rh&(28)-1-Y&\2 Ob_x(Adr%(28),0)=X_desk&+X&\2 Rx&(28)=X_desk& Ob_w(Adr%(28),0)=W_desk&-X&\2 Ob_w(Adr%(28),1)=W_desk&-X&\2 Rw&(28)=W_desk&-X&\2 ' Exadr%=-1 ! buffer addr pour Get/Put ' Gosub Rsc_defs ' En_6&=En_1&+6 Px_last&=Px_first&+7 Px_conflast&=Px_conf&+7 ' Am_last&=Am_first&+5 ' Char{{Ob_spec(Adr%(6),Am_first&)}}="11" Char{{Ob_spec(Adr%(6),Am_first&+1)}}="3614" Char{{Ob_spec(Adr%(6),Am_first&+2)}}=lot x&+1,y&+1 &Ìplot x&,y& &fÌ Ìoccupp‚ ^fp Ôâ&!â(fÌ Inpmid$Log10(Val( Char{{Ob_spec(Adr%(6),Am_first&+3)}}="3616" Char{{Ob_spec(Adr%(6),Am_first&+4)}}="3617" Char{{Ob_spec(Adr%(6),Am_first&+5)}}="3613" ' Char{{Ob_spec(Adr%(39),Es_id&)}}="" ! USER ID ' Char{{Ob_spec(Adr%(6),Am_se&)}}="ATD3614" Char{{Ob_spec(Adr%(6),Am_co&)}}="3614" ' ' Char{{Ob_spec(Adr%(2),Rsc_isw&)}}="* * * * S w e e t e l 2 * * * *" Char{Ob_spec(Adr%(2),Rsc_isw&)}="S w e e t e l 2" Char{{Ob_spec(Adr%(2),Rsc_iver&)}}=Left$("version "+Release$+" ("+Reldate$+")",32) ' ' M_xinfos&=M_infos&+1 ! Info qd on a 1 menu en plus ' CF: LA RUSE DU SIECLE: METTRE UN DUMMY_OBJECT A LA FIN DE FICHIER ' ' gestion des popups: ' Adrpop%=Adr%(Popup&) @Popinit For X&=1 To 40 @Popset(Adr%(X&)) Next X& ' @Sel_pop(Adr%(18),Dg_1&,2) ! ‚tendu ' ~Objc_offset(Adr%(Menu&),M_infos&,X&,Y&) Y_desk&=Min(Max(Y_desk&,Y&),64) ' Chrsc!=False If W_desk&<640 ! tros petit! Chrsc!=True For X&=0 To 6 ' For Y&=0 To 4 If X&<>6 ~Menu_text(Adr%(Menu&),M_1st&+X&,Mid$(Char{Ob_spec(Adr%(Menu&),M_1st&+X&)},2,4)+Chr$(0)) Ob_w(Adr%(Menu&),M_1st&+X&)=5*$ And And And And Eqv Xor Endif Ob_x(Adr%(Menu&),M_1st&+X&)=X&*5*8 ' Next Y& Next X& ' For X&=0 To 4 Ob_x(Adr%(Menu&),M_infos&-1)=8 Ob_x(Adr%(Menu&),M_c_load&-1)=1*5*8+8 Ob_x(Adr%(Menu&),M_f1&-1)=2*$ And And And And Eqv Or *8+8 Ob_x(Adr%(Menu&),M_f2&-1)=3*$ And And And And Eqv Or *8+8 Ob_x(Adr%(Menu&),M_efface&-1)=Min(4*5*$ And And And And Eqv Xor +8,W_desk&-Ob_w(Adr%(Menu&),M_efface&-1)) Ob_x(Adr%(Menu&),M_c_n&-1)=Min(5*5*$ And And And And Eqv Xor +8,W_desk&-Ob_w(Adr%(Menu&),M_c_n&-1)) Ob_x(Adr%(Menu&),M_first&-1)=Min(6*5*$ And And And And Eqv Xor +8,W_desk&-Ob_w(Adr%(Menu&),M_first&-1)) ' Next X& Endif ' Return Procedure Rsc_defs Rem Indice du ressource pour SWEETEL2 ' Let Swicone&=0 ! Formulaire/Dialogue ' Let Options&=1 ! Formulaire/Dialogue Let Rsc_mul&=5 ! BOX dans l'arbre OPTIONS Let Rsc_moins&=7 ! BUTTON dans l'arbre OPTIONS Let Rsc_num&=8 ! TEXT dans l'arbre OPTIONS Let Rsc_plus&=9 ! BUTTON dans l'arbre OPTIONS Let Rsc_comp&=11 ! BOX dans l'arbre OPTIONS Let Rsc_ema0&=12 ! BUTTON dans l'arbre OPTIONS Let Rsc_len&=15 ! BOX dans l'arbre OPTIONS Let Rsc_vdt&=17 ! BUTTON dans l'arbre OPTIONS Let Rsc_1200&=19 ! BUTTON dans l'arbre OPTIONS Let Rsc_b1&=21 ! BUTTON dans l'arbre OPTIONS Let Rsc_mem&=22 ! BOXTEXT dans l'arbre OPTIONS Let Rsc_dyn&=25 ! BOX dans l'arbre OPTIONS Let Rsc_bak&=27 ! BOX dans l'arbre OPTIONS Let Rsc_eff&=31 ! BOX dans l'arbre OPTIONS Let Rsc_log&=32 ! BOX dans l'arbre OPTIONS Let Rsc_d0&=33 ! BUTTON dans l'arbre OPTIONS Let Rsc_ok&=34 ! BUTTON dans l'arbre OPTIONS Let Rsc_save&=35 ! BUTTON dans l'arbre OPTIONS Let Rsc_cancel&=36 ! BUTTON dans l'arbre OPTIONS ' Let Infos&=2 ! Formulaire/Dialogue Let Rsc_isw&=2 ! BUTTON dans l'arbre INFOS Let Rsc_ibox&=4 ! BOX dans l'arbre INFOS Let Rsc_iver&=10 ! TEXT dans l'arbre INFOS Let Rsc_iok&=12 ! BUTTON dans l'arbre INFOS Let Rsc_ihlp&=13 ! BUTTON dans l'arbre INFOS ' Let Input&=3 ! Formulaire/Dialogue Let Rsc_nty&=2 ! BUTTON dans l'arbre INPUT Let Rsc_nt&=3 ! FBOXTEXT dans l'arbre INPUT Let Rsc_nok&=4 ! BUTTON dans l'arbre INPUT Let Rsc_nca&=5 ! BUTTON dans l'arbre INPUT ' Let Menug&=4 ! Formulaire/Dialogue Let Rsc_gcadr0&=2 ! BUTTON dans l'arbre MENUG Let Rsc_gloupe&=4 ! BUTTON dans l'arbre MENUG Let Rsc_gdefloupe&=5 ! BUTTON dans l'arbre MENUG Let Rsc_gmog0&=7 ! BUTTON dans l'arbre MENUG Let Rsc_gcircle&=8 ! ICON dans l'arbre MENUG Let Rsc_gfcircle&=9 ! ICON dans l'arbre MENUG Let Rsc_gbox&=10 ! ICON dans l'arbre MENUG Let Rsc_gfbox&=11 ! ICON dans l'arbre MENUG Let Rsc_gline&=12 ! ICON dans l'arbre MENUG Let Rsc_gbez&=13 ! ICON dans l'arbre MENUG Let Rsc_gfill&=14 ! ICON dans l'arbre MENUG Let Rsc_gbrush&=15 ! ICON dans l'arbre MENUG Let Rsc_gtxt&=16 ! ICON dans l'arbre MENUG Let Rsc_gdeftxt&=17 ! ICON dans l'arbre MENUG Let Rsc_ghflip&=18 ! ICON dans l'arbre MENUG Let Rsc_gvflip&=19 ! ICON dans l'arbre MENUG Let Rsc_gclr&=20 ! ICON dans l'arbre MENUG Let Rsc_gfclr&=21 ! ICON dans l'arbre MENUG Let Rsc_ginv&=22 ! USERDEF dans l'arbre MENUG Let Rsc_gload&=23 ! ICON dans l'arbre MENUG Let Rsc_gsave&=24 ! ICON dans l'arbre MENUG Let Rsc_gcancel&=25 ! BUTTON dans l'arbre MENUG ' Let Text&=5 ! Formulaire/Dialogue Let Rsc_stu1&=3 ! BUTTON dans l'arbre TEXT Let Rsc_stu2&=4 ! BUTTON dans l'arbre TEXT Let Rsc_stup&=7 ! BUTTON dans l'arbre TEXT Let Rsc_box&=8 ! BOX dans l'arbre TEXT Let Rsc_std1&=9 ! BUTTON dans l'arbre TEXT Let Rsc_std2&=10 ! BUTTON dans l'arbre TEXT Let Rsc_fdw&=11 ! BUTTON dans l'arbre TEXT Let Rsc_fup&=12 ! BUTTON dans l'arbre TEXT Let Rsc_stdw&=13 ! BUTTON dans l'arbre TEXT Let Rsc_stx&=14 ! TEXT dans l'arbre TEXT Let Rsc_stok&=16 ! BUTTON dans l'arbre TEXT ' Let Hlp_emul&=6 ! Formulaire/Dialogue Let Am_con&=4 ! TEXT dans l'arbre HLP_EMUL Let Am_som&=6 ! TEXT dans l'arbre HLP_EMUL Let Am_ann&=8 ! TEXT dans l'arbre HLP_EMUL Let Am_ret&=10 ! TEXT dans l'arbre HLP_EMUL Let Am_rep&=12 ! TEXT dans l'arbre HLP_EMUL Let Am_gui&=19 ! TEXT dans l'arbre HLP_EMUL Let Am_cor&=21 ! TEXT dans l'arbre HLP_EMUL Let Am_sui&=23 ! TEXT dans l'arbre HLP_EMUL Let Am_env&=25 ! TEXT dans l'arbre HLP_EMUL Let Am_cnx&=31 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_dcn&=32 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_lin&=34 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_lib&=35 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_com&=36 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_co&=37 ! FTEXT dans l'arbre HLP_EMUL Let Am_first&=38 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_seq&=44 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_se2&=45 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_se&=46 ! FTEXT dans l'arbre HLP_EMUL Let Am_cancel&=47 ! BUTTON dans l'arbre HLP_EMUL ' ' Let Em_setup&=7 ! Formulaire/Dialogue Let Cv_ch&=6 ! TEXT dans l'arbre EM_SETUP Let Cv_gl&=9 ! TEXT dans l'arbre EM_SETUP Let Cv_tl&=12 ! FTEXT dans l'arbre EM_SETUP Let Cv_in&=13 ! BUTTON dans l'arbre EM_SETUP Let Cv_vd&=14 ! BUTTON dans l'arbre EM_SETUP Let Cv_ok&=15 ! BUTTON dans l'arbre EM_SETUP ' Let Emulcol&=8 ! Formulaire/Dialogue Let Ec_cbox&=3 ! BOX dans l'arbre EMULCOL Let Ec_c0&=4 ! BOXTEXT dans l'arbre EMULCOL Let Ec_c7&=11 ! BOXTEXT dans l'arbre EMULCOL Let Ec_tnp&=25 ! BUTTON dans l'arbre EMULCOL Let Ec_bn&=27 ! BOX dans l'arbre EMULCOL Let Ec_tnm&=28 ! BUTTON dans l'arbre EMULCOL Let Ec_bp&=32 ! BUTTON dans l'arbre EMULCOL Let Ec_box&=33 ! BOX dans l'arbre EMULCOL Let Ec_bm&=34 ! BUTTON dans l'arbre EMULCOL Let Ec_stp&=37 ! BUTTON dans l'arbre EMULCOL Let Ec_stm&=38 ! BUTTON dans l'arbre EMULCOL Let Ec_idp&=41 ! BUTTON dans l'arbre EMULCOL Let Ec_idm&=42 ! BUTTON dans l'arbre EMULCOL Let Ec_tfp&=45 ! BUTTON dans l'arbre EMULCOL Let Ec_cli&=46 ! BUTTON dans l'arbre EMULCOL Let Ec_bc&=47 ! BOX dans l'arbre EMULCOL Let Ec_tfm&=48 ! BUTTON dans l'arbre EMULCOL Let Ec_text&=49 ! BUTTON dans l'arbre EMULCOL Let Ec_save&=50 ! BUTTON dans l'arbre EMULCOL Let Ec_ok&=51 ! BUTTON dans l'arbre EMULCOL ' Let Em_motif&=9 ! Formulaire/Dialogue ' Let Mnu_rien&=10 ! Arbre menu ' Let Mnu_editi&=11 ! Arbre menu Let M_newtitle&=3 ! TITLE dans l'arbre MNU_EDITI Let M_ed_a_f&=6 ! STRING dans l'arbre MNU_EDITI Let M_ed_a_n&=7 ! STRING dans l'arbre MNU_EDITI Let M_ed_a_e&=8 ! STRING dans l'arbre MNU_EDITI Let M_ed_a_b&=10 ! STRING dans l'arbre MNU_EDITI Let M_ed_a_k&=11 ! STRING dans l'arbre MNU_EDITI Let M_ed_c_v&=12 ! STRING dans l'arbre MNU_EDITI Let M_ed_c_dl&=13 ! STRING dans l'arbre MNU_EDITI Let M_ed_c_ch&=14 ! STRING dans l'arbre MNU_EDITI Let M_ed_c_p&=15 ! STRING dans l'arbre MNU_EDITI Let M_ed_a_c&=17 ! STRING dans l'arbre MNU_EDITI ' Let Mnu_grap&=12 ! Arbre menu Let M_gr_b&=6 ! STRING dans l'arbre MNU_GRAP Let M_gr_a_b&=7 ! STRING dans l'arbre MNU_GRAP Let M_gr_c&=8 ! STRING dans l'arbre MNU_GRAP Let M_gr_a_c&=9 ! STRING dans l'arbre MNU_GRAP Let M_gr_n&=11 ! STRING dans l'arbre MNU_GRAP Let M_gr_p&=12 ! STRING dans l'arbre MNU_GRAP Let M_gr_x&=13 ! STRING dans l'arbre MNU_GRAP Let M_gr_f&=14 ! STRING dans l'arbre MNU_GRAP Let M_gr_t&=16 ! STRING dans l'arbre MNU_GRAP Let M_gr_a_t&=17 ! STRING dans l'arbre MNU_GRAP Let M_gr_i&=19 ! STRING dans l'arbre MNU_GRAP Let M_gr_e&=20 ! STRING dans l'arbre MNU_GRAP Let M_gr_a_e&=21 ! STRING dans l'arbre MNU_GRAP Let M_gr_c_h&=23 ! STRING dans l'arbre MNU_GRAP Let M_gr_c_v&=24 ! STRING dans l'arbre MNU_GRAP Let M_gr_l&=26 ! STRING dans l'arbre MNU_GRAP Let M_gr_s&=27 ! STRING dans l'arbre MNU_GRAP ' Let Mnu_emul&=13 ! Arbre menu Let M_em_equ&=6 ! STRING dans l'arbre MNU_EMUL Let M_em_tc&=7 ! STRING dans l'arbre MNU_EMUL Let M_em_on&=9 ! STRING dans l'arbre MNU_EMUL Let M_em_off&=10 ! STRING dans l'arbre MNU_EMUL Let M_em_40&=11 ! STRING dans l'arbre MNU_EMUL Let M_em_80&=12 ! STRING dans l'arbre MNU_EMUL Let M_em_cls&=13 ! STRING dans l'arbre MNU_EMUL Let M_em_in&=14 ! STRING dans l'arbre MNU_EMUL Let M_em_col&=16 ! STRING dans l'arbre MNU_EMUL Let M_em_vdi&=17 ! STRING dans l'arbre MNU_EMUL Let M_em_ca&=18 ! STRING dans l'arbre MNU_EMUL Let M_em_spg&=20 ! STRING dans l'arbre MNU_EMUL ' Let Mnu_drcs&=14 ! Arbre menu Let Dr_g0&=6 ! STRING dans l'arbre MNU_DRCS Let Dr_g0p&=7 ! STRING dans l'arbre MNU_DRCS Let Dr_g1&=8 ! STRING dans l'arbre MNU_DRCS Let Dr_g1p&=9 ! STRING dans l'arbre MNU_DRCS Let Dr_tel&=11 ! STRING dans l'arbre MNU_DRCS Let Dr_tel2&=12 ! STRING dans l'arbre MNU_DRCS Let Dr_capt&=13 ! STRING dans l'arbre MNU_DRCS Let Dr_ldj&=15 ! STRING dans l'arbre MNU_DRCS Let Dr_ldj2&=16 ! STRING dans l'arbre MNU_DRCS Let Dr_impj&=17 ! STRING dans l'arbre MNU_DRCS Let Dr_clr&=18 ! STRING dans l'arbre MNU_DRCS Let Dr_svj&=20 ! STRING dans l'arbre MNU_DRCS Let Dr_svj2&=21 ! STRING dans l'arbre MNU_DRCS Let Dr_svt&=22 ! STRING dans l'arbre MNU_DRCS Let Dr_svt2&=23 ! STRING dans l'arbre MNU_DRCS Let Dr_dgt&=25 ! STRING dans l'arbre MNU_DRCS Let Dg_parx&=27 ! STRING dans l'arbre MNU_DRCS ' Let Ranger&=15 ! Formulaire/Dialogue Let Rng_1&=20 ! BUTTON dans l'arbre RANGER ' Let Ed_drcs&=16 ! Formulaire/Dialogue Let Dr_cadr&=3 ! BOX dans l'arbre ED_DRCS Let Dr_first&=4 ! BOX dans l'arbre ED_DRCS Let Dr_last&=83 ! BOX dans l'arbre ED_DRCS Let Dr_eff&=84 ! BUTTON dans l'arbre ED_DRCS Let Dr_fill&=85 ! BUTTON dans l'arbre ED_DRCS Let Dr_hflip&=86 ! BUTTON dans l'arbre ED_DRCS Let Dr_vflip&=87 ! BUTTON dans l'arbre ED_DRCS Let Dr_inv&=88 ! BUTTON dans l'arbre ED_DRCS Let Dr_h&=90 ! BUTTON dans l'arbre ED_DRCS Let Dr_b&=91 ! BUTTON dans l'arbre ED_DRCS Let Dr_g&=92 ! BUTTON dans l'arbre ED_DRCS Let Dr_d&=93 ! BUTTON dans l'arbre ED_DRCS Let Dr_load&=94 ! BUTTON dans l'arbre ED_DRCS Let Dr_save&=95 ! BUTTON dans l'arbre ED_DRCS Let Dr_char&=96 ! TEXT dans l'arbre ED_DRCS Let Dr_next&=97 ! BUTTON dans l'arbre ED_DRCS Let Dr_cancel&=98 ! BUTTON dans l'arbre ED_DRCS Let Dr_ok&=99 ! BUTTON dans l'arbre ED_DRCS ' Let Dr_sel&=17 ! Formulaire/Dialogue Let Ds_tit&=2 ! BUTTON dans l'arbre DR_SEL Let Ds_tp&=4 ! BUTTON dans l'arbre DR_SEL Let Ds_tm&=5 ! BUTTON dans l'arbre DR_SEL Let Ds_t&=6 ! BOX dans l'arbre DR_SEL Let Ds_tfirst&=7 ! STRING dans l'arbre DR_SEL Let Ds_tlast&=100 ! STRING dans l'arbre DR_SEL Let Ds_gp&=102 ! BUTTON dans l'arbre DR_SEL Let Ds_gm&=103 ! BUTTON dans l'arbre DR_SEL Let Ds_g&=104 ! BOX dans l'arbre DR_SEL Let Ds_gfirst&=105 ! STRING dans l'arbre DR_SEL Let Ds_glast&=198 ! STRING dans l'arbre DR_SEL Let Ts_ok&=199 ! BUTTON dans l'arbre DR_SEL Let Ts_cancel&=200 ! BUTTON dans l'arbre DR_SEL ' Let Digit&=18 ! Formulaire/Dialogue Let Dg_x&=3 ! FTEXT dans l'arbre DIGIT Let Dg_y&=4 ! FTEXT dans l'arbre DIGIT Let Dg_t&=5 ! FTEXT dans l'arbre DIGIT Let Dg_f&=6 ! FTEXT dans l'arbre DIGIT Let Dg_back&=8 ! BOXTEXT dans l'arbre DIGIT Let Dg_load&=10 ! BOXTEXT dans l'arbre DIGIT Let Dg_box&=11 ! BOX dans l'arbre DIGIT Let Dg_l1&=13 ! BOXTEXT dans l'arbre DIGIT Let Dg_eff&=14 ! BUTTON dans l'arbre DIGIT Let Dg_l2&=16 ! BOXTEXT dans l'arbre DIGIT Let Dg_pol&=18 ! BOXTEXT dans l'arbre DIGIT Let Dg_selp&=20 ! BOXTEXT dans l'arbre DIGIT Let Dg_1&=22 ! BUTTON dans l'arbre DIGIT Let Dg_ok&=23 ! BUTTON dans l'arbre DIGIT Let Dg_tst&=24 ! BUTTON dans l'arbre DIGIT Let Dg_cancel&=25 ! BUTTON dans l'arbre DIGIT ' Let Sans_nom&=19 ! Formulaire/Dialogue ' Let Digitype&=20 ! Formulaire/Dialogue Let Dg3_ifx&=3 ! BUTTON dans l'arbre DIGITYPE Let Dg3_load&=4 ! BUTTON dans l'arbre DIGITYPE Let Dg3_acq&=6 ! BUTTON dans l'arbre DIGITYPE ' Let Progress&=21 ! Formulaire/Dialogue Let Pr_txt&=1 ! TEXT dans l'arbre PROGRESS Let Pr_box&=2 ! BOX dans l'arbre PROGRESS Let Pr_sl&=3 ! BOX dans l'arbre PROGRESS ' Let Envoi&=22 ! Formulaire/Dialogue Let En_min&=5 ! BUTTON dans l'arbre ENVOI Let En_scr&=6 ! BUTTON dans l'arbre ENVOI Let En_two&=7 ! BUTTON dans l'arbre ENVOI Let En_slw&=8 ! BUTTON dans l'arbre ENVOI Let En_ok&=9 ! BUTTON dans l'arbre ENVOI Let En_1&=10 ! BUTTON dans l'arbre ENVOI Let En_no&=17 ! FTEXT dans l'arbre ENVOI Let En_env&=18 ! BUTTON dans l'arbre ENVOI ' Let Minidraw&=23 ! Formulaire/Dialogue Let Md_txt0&=5 ! BOXTEXT dans l'arbre MINIDRAW Let Md_txt7&=12 ! BOXTEXT dans l'arbre MINIDRAW Let Md_gr0&=15 ! BOXTEXT dans l'arbre MINIDRAW Let Md_gr7&=22 ! BOXTEXT dans l'arbre MINIDRAW Let Md_cli&=24 ! BUTTON dans l'arbre MINIDRAW Let Md_lin&=25 ! BUTTON dans l'arbre MINIDRAW Let Md_inv&=26 ! BUTTON dans l'arbre MINIDRAW Let Md_txt&=28 ! BUTTON dans l'arbre MINIDRAW Let Md_grf&=29 ! BUTTON dans l'arbre MINIDRAW Let Md_drcs&=30 ! BUTTON dans l'arbre MINIDRAW Let Md_seg&=31 ! BUTTON dans l'arbre MINIDRAW Let Md_tl1&=33 ! BUTTON dans l'arbre MINIDRAW Let Md_tl2&=34 ! BUTTON dans l'arbre MINIDRAW Let Md_tl3&=35 ! BUTTON dans l'arbre MINIDRAW Let Md_tl4&=36 ! BUTTON dans l'arbre MINIDRAW Let Md_ok&=37 ! BUTTON dans l'arbre MINIDRAW Let Md_cancel&=38 ! BUTTON dans l'arbre MINIDRAW ' Let Parxd&=24 ! Formulaire/Dialogue Let Px_info&=2 ! BUTTON dans l'arbre PARXD Let Px_conf&=4 ! BOXTEXT dans l'arbre PARXD Let Px_first&=13 ! STRING dans l'arbre PARXD Let Px_up&=21 ! BOXTEXT dans l'arbre PARXD Let Px_dwn&=22 ! BOXTEXT dans l'arbre PARXD Let Px_can&=23 ! BUTTON dans l'arbre PARXD ' Let Env_save&=25 ! Formulaire/Dialogue Let Sg_title&=2 ! BUTTON dans l'arbre ENV_SAVE Let Sg_src&=3 ! BOXTEXT dans l'arbre ENV_SAVE Let Sg_1&=5 ! BUTTON dans l'arbre ENV_SAVE Let Sg_2&=6 ! BUTTON dans l'arbre ENV_SAVE Let Sg_3&=7 ! BUTTON dans l'arbre ENV_SAVE Let Sg_4&=8 ! BUTTON dans l'arbre ENV_SAVE Let Sg_5&=9 ! BUTTON dans l'arbre ENV_SAVE Let Sg_6&=10 ! BUTTON dans l'arbre ENV_SAVE Let Sg_grf&=11 ! BOXTEXT dans l'arbre ENV_SAVE Let Sg_seg&=12 ! BOXTEXT dans l'arbre ENV_SAVE Let Sg_drcs&=13 ! BOXTEXT dans l'arbre ENV_SAVE Let Sg_bit&=14 ! BOXTEXT dans l'arbre ENV_SAVE Let Sg_ok&=15 ! BUTTON dans l'arbre ENV_SAVE ' Let Em_pannel&=26 ! Formulaire/Dialogue Let Em_p1&=2 ! BOX dans l'arbre EM_PANNEL Let Em_pc&=12 ! BUTTON dans l'arbre EM_PANNEL Let Em_pm&=14 ! BUTTON dans l'arbre EM_PANNEL Let Em_bs&=15 ! BOX dans l'arbre EM_PANNEL Let Em_sl&=16 ! BOX dans l'arbre EM_PANNEL Let Em_pp&=17 ! BUTTON dans l'arbre EM_PANNEL ' Let Mt_obj&=27 ! Formulaire/Dialogue ' Let Rline&=28 ! Formulaire/Dialogue ' Let Col8&=29 ! Formulaire/Dialogue Let C8_c0&=3 ! BOXTEXT dans l'arbre COL8 Let C8_t0&=11 ! TEXT dans l'arbre COL8 ' Let Proc&=30 ! Formulaire/Dialogue Let Pa_nom&=3 ! FTEXT dans l'arbre PROC Let Pa_box&=4 ! BOX dans l'arbre PROC Let Pa_t1&=5 ! TEXT dans l'arbre PROC Let Pa_t10&=10 ! TEXT dans l'arbre PROC Let Pa_mm&=12 ! BUTTON dans l'arbre PROC Let Pa_maxpar&=13 ! BOXTEXT dans l'arbre PROC Let Pa_mp&=14 ! BUTTON dans l'arbre PROC Let Pa_box2&=15 ! BOX dans l'arbre PROC Let Pa_c1&=16 ! STRING dans l'arbre PROC Let Pa_nm&=20 ! BUTTON dans l'arbre PROC Let Pa_npar&=21 ! FBOXTEXT dans l'arbre PROC Let Pa_np&=22 ! BUTTON dans l'arbre PROC Let Pa_ok&=23 ! BUTTON dans l'arbre PROC Let Pa_ann&=24 ! BUTTON dans l'arbre PROC ' Let Sw2&=31 ! Formulaire/Dialogue ' Let Sbox&=32 ! Formulaire/Dialogue ' Let Finfo&=33 ! Formulaire/Dialogue Let Fi_text&=2 ! TEXT dans l'arbre FINFO ' Let Stat&=34 ! Formulaire/Dialogue Let St_xx&=2 ! BUTTON dans l'arbre STAT Let St_on&=3 ! BUTTON dans l'arbre STAT Let St_off&=4 ! BUTTON dans l'arbre STAT Let St_ok&=5 ! BUTTON dans l'arbre STAT Let St_ann&=6 ! BUTTON dans l'arbre STAT ' Let Popwin&=35 ! Formulaire/Dialogue ' Let Minid2&=36 ! Formulaire/Dialogue Let Seg_ld&=3 ! BUTTON dans l'arbre MINID2 Let Seg_ex&=4 ! BUTTON dans l'arbre MINID2 Let Seg_no&=6 ! BUTTON dans l'arbre MINID2 Let Seg_in&=7 ! BUTTON dans l'arbre MINID2 Let Seg_sv&=8 ! BUTTON dans l'arbre MINID2 Let Seg_ef&=9 ! BUTTON dans l'arbre MINID2 Let Seg_an&=10 ! BUTTON dans l'arbre MINID2 ' Let Drm&=37 ! Formulaire/Dialogue Let Drm10&=4 ! BUTTON dans l'arbre DRM Let Drmc&=5 ! BUTTON dans l'arbre DRM Let Drmok&=6 ! BUTTON dans l'arbre DRM ' Let Drb&=38 ! Formulaire/Dialogue Let Drb_l&=3 ! BUTTON dans l'arbre DRB Let Drb_s&=4 ! BUTTON dans l'arbre DRB Let Drb_i&=5 ! BUTTON dans l'arbre DRB Let Drb_x&=6 ! BUTTON dans l'arbre DRB Let Drb_t&=7 ! BUTTON dans l'arbre DRB Let Drb_e&=8 ! BUTTON dans l'arbre DRB Let Drb_g&=9 ! BUTTON dans l'arbre DRB Let Drb_c&=10 ! BUTTON dans l'arbre DRB ' Let Statem&=39 ! Formulaire/Dialogue Let Es_emu&=3 ! BUTTON dans l'arbre STATEM Let Es_des&=4 ! BUTTON dans l'arbre STATEM Let Es_off&=5 ! BOXTEXT dans l'arbre STATEM Let Es_emr&=6 ! BUTTON dans l'arbre STATEM Let Es_rep&=10 ! BUTTON dans l'arbre STATEM Let Es_cn&=11 ! BUTTON dans l'arbre STATEM Let Es_d0&=14 ! BUTTON dans l'arbre STATEM Let Es_d1&=15 ! BUTTON dans l'arbre STATEM Let Es_ro&=16 ! BUTTON dans l'arbre STATEM Let Es_id&=18 ! FTEXT dans l'arbre STATEM Let Es_ok&=19 ! BUTTON dans l'arbre STATEM ' Let Desa&=40 ! Formulaire/Dialogue Let Des_r&=3 ! BUTTON dans l'arbre DESA Let Des_1&=4 ! BUTTON dans l'arbre DESA Let Des_blk&=5 ! BUTTON dans l'arbre DESA Let Des_ok&=6 ! BUTTON dans l'arbre DESA ' Let Popup&=41 ! Formulaire/Dialogue ' Let Parxp&=42 ! Formulaire/Dialogue Let Px2_path&=4 ! BUTTON dans l'arbre PARXP Let Px2_rim&=7 ! BOX dans l'arbre PARXP Let Px2_wim&=9 ! BOX dans l'arbre PARXP Let Px2_ifx&=11 ! BOX dans l'arbre PARXP Let Px2_trm&=13 ! BOX dans l'arbre PARXP Let Px2_card&=14 ! BUTTON dans l'arbre PARXP Let Px2_pal&=16 ! BOX dans l'arbre PARXP Let Px2_sv&=17 ! BUTTON dans l'arbre PARXP Let Px2_ok&=18 ! BUTTON dans l'arbre PARXP Let Px2_cancel&=19 ! BUTTON dans l'arbre PARXP ' Let Menu&=43 ! Arbre menu Let M_1st&=3 ! TITLE dans l'arbre MENU Let M_ii&=8 ! TITLE dans l'arbre MENU Let M_title&=9 ! TITLE dans l'arbre MENU Let M_infos&=12 ! STRING dans l'arbre MENU Let M_c_load&=21 ! STRING dans l'arbre MENU Let M_c_save&=22 ! STRING dans l'arbre MENU Let M_c_l&=24 ! STRING dans l'arbre MENU Let M_sf1&=25 ! STRING dans l'arbre MENU Let M_a_n&=26 ! STRING dans l'arbre MENU Let M_new&=27 ! STRING dans l'arbre MENU Let M_c_s2&=28 ! STRING dans l'arbre MENU Let M_c_s&=29 ! STRING dans l'arbre MENU Let M_sf2&=30 ! STRING dans l'arbre MENU Let M_finfo&=32 ! STRING dans l'arbre MENU Let M_fdel&=33 ! STRING dans l'arbre MENU Let M_c_q&=35 ! STRING dans l'arbre MENU Let M_f1&=37 ! STRING dans l'arbre MENU Let M_f10&=38 ! STRING dans l'arbre MENU Let M_c_a&=39 ! STRING dans l'arbre MENU Let M_f2&=41 ! STRING dans l'arbre MENU Let M_f9&=42 ! STRING dans l'arbre MENU Let M_f5&=43 ! STRING dans l'arbre MENU Let M_f6&=45 ! STRING dans l'arbre MENU Let M_c_e&=47 ! STRING dans l'arbre MENU Let M_a_e&=48 ! STRING dans l'arbre MENU Let M_f3&=50 ! STRING dans l'arbre MENU Let M_f4&=51 ! STRING dans l'arbre MENU Let M_efface&=53 ! STRING dans l'arbre MENU Let M_c_rr&=54 ! STRING dans l'arbre MENU Let M_a_r&=55 ! STRING dans l'arbre MENU Let M_config&=57 ! STRING dans l'arbre MENU Let M_c_n&=59 ! STRING dans l'arbre MENU Let M_c_f&=60 ! STRING dans l'arbre MENU Let M_c_f2&=61 ! STRING dans l'arbre MENU Let M_icn&=62 ! STRING dans l'arbre MENU Let M_c_k&=63 ! STRING dans l'arbre MENU Let M_c_w&=64 ! STRING dans l'arbre MENU Let M_c_g&=66 ! STRING dans l'arbre MENU Let M_c_d&=67 ! STRING dans l'arbre MENU Let M_c_t&=68 ! STRING dans l'arbre MENU Let M_c_r&=69 ! STRING dans l'arbre MENU Let M_drcs&=70 ! STRING dans l'arbre MENU Let M_c_o&=71 ! STRING dans l'arbre MENU Let M_ranger&=73 ! STRING dans l'arbre MENU Let M_texte&=74 ! STRING dans l'arbre MENU Let M_c_p&=75 ! STRING dans l'arbre MENU Let M_first&=77 ! STRING dans l'arbre MENU Let M_last&=99 ! STRING dans l'arbre MENU ' Let Mnu_bit&=44 ! Arbre menu Let Bt_load&=6 ! STRING dans l'arbre MNU_BIT Let Bt_ac&=7 ! STRING dans l'arbre MNU_BIT Let Bt_ifx&=8 ! STRING dans l'arbre MNU_BIT Let Bt_clr&=10 ! STRING dans l'arbre MNU_BIT Let Bt_last&=12 ! STRING dans l'arbre MNU_BIT Let Bt_parx&=14 ! STRING dans l'arbre MNU_BIT Return ' ' Flag!=0 (draw) -1 (end) E$ info Procedure Progress(Flag!,P&,E$) Local N& ' If Not Flag! If Len(E$)>0 E$=Left$(E$+"..",38) Char{{Ob_spec(Adr%(Progress&),Pr_txt&)}}=E$ Endif If Set_progress! Wmove(0,0,0,0,Rx&(Progress&),Ry&(Progress&),Rw&(Progress&),Rh&(Progress&)) Ob_h(Adr%(Progress&),Pr_sl&)=Ob_h(Adr%(Progress&),Pr_box&)-1 Ob_w(Adr%(Progress&),Pr_sl&)=0 ~@Form_exdo(Progress&,-2) ' ~Objc_draw(Adr%(Progress&),0,&HFF,Rx&(Progress&),Ry&(Progress&),Rw&(Progress&),Rh&(Progress&)) Set_progress!=False ' Else if P&<0 ! un autre slide Ob_w(Adr%(Progress&),Pr_sl&)=0 ~Objc_draw(Adr%(Progress&),0,&HFF,Rx&(Progress&),Ry&(Progress&),Rw&(Progress&),Rh&(Progress&)) Endif If Len(E$)>0 ~Objc_draw(Adr%(Progress&),Pr_txt&,&HFF,Rx&(Progress&),Ry&(Progress&),Rw&(Progress&),Rh&(Progress&)) Endif Ob_w(Adr%(Progress&),Pr_sl&)=(P&*Ob_w(Adr%(Progress&),Pr_box&))\100 ~Objc_draw(Adr%(Progress&),Pr_sl&,&HFF,Rx&(Progress&),Ry&(Progress&),Rw&(Progress&),Rh&(Progress&)) Gosub Defmouse(2) Else If Set_progress!=False Ob_w(Adr%(Progress&),Pr_sl&)=Ob_w(Adr%(Progress&),Pr_box&) ~Objc_draw(Adr%(Progress&),Pr_box&,&HFF,Rx&(Progress&),Ry&(Progress&),Rw&(Progress&),Rh&(Progress&)) N&=@Wind_update01(-1) ~@Wind_update01(0) Set_progress!=True ' ~Form_dial(3,0,0,0,0,Rx&(Progress&),Ry&(Progress&),Rw&(Progress&),Rh&(Progress&)) ~@Form_exdo(Progress&,-3) Gosub W_rdexe Wmove(Rx&(Progress&),Ry&(Progress&),Rw&(Progress&),Rh&(Progress&),0,0,0,0) ~@Wind_update01(N&) Endif Endif Return ' ' ' Function Upcase(Key&) $S& Select Key& Case "a" To "z" Return Bclr(Key&,5) Default Return Key& Endselect $S% Endfunc ' Function Equ_menu(N&) $F% Local Ha& ' $S& Select N& Case M_c_load& Return 12 Case M_c_save& Return 19 ' Case M_f10& ! Comp+Opt Return 196 Case M_infos& ! Info Return -9 Case M_c_l& ! Load Return 912 Case M_sf1& ! ASave Return 212 Case M_a_n& ! iNsert Return -177 Case M_c_s& ! ^>Save File$(0)=Chr$(0)+File$(0) Return 919 Case M_c_s2& ! ^Save Return 919 Case M_sf2& ! ALoad Return 213 Case M_new& ! New file Return -3 Case M_finfo& ! Info fichier Return 500 Case M_fdel& ! Delete file Return 501 Case M_c_q& ! Quit Sweetel Return 17 Case M_f1& ! Compile Return 187 Case M_c_a& ! ..ascii Return -1 Case M_f2& ! Opt Return 188 Case M_f9& ! Return 195 Case M_f6& ! Return 192 Case M_f5& ! Capturer Return 191 Case M_c_e& ! Send Return 5 Case M_a_e& ! ..clavier Return -146 Case M_f3& ! Return 189 Case M_f4& ! Return 190 Case M_config& ! Configurer prise ' Return ??? Return -16 Case M_efface& ! Effacer ‚cran Return -69 Case M_c_rr& ! Init Return -82 Case M_a_r& ! Synchroniser prise Return -147 Case M_c_n& ! Next window Return 14 Case M_c_f& ! Full window Return 6 Case M_c_f2& ! Fullscreen window Return 2 Case M_c_k& ! Fermer Return 11 Case M_icn& ! Smaller Return 511 Case M_c_w& ! OpenAll Return 23 Case M_c_d& ! Fenˆtre: editeur Return 4 Case M_c_g& ! ..graphique Return 7 Case M_c_t& ! ..‚mul Return 20 Case M_c_o& ! ..liste Return 15 Case M_c_r& ! ..DRCS Return 18 Case M_drcs& ! ..bitmap DRCS Return 278 Case M_ranger& ! Arrange windows Return -87 Case M_texte& ! Set texte color & effetx Return -84 Case M_c_p& ! Options Return -16 ' Default ' Select Menu_id& Case 11 ' Menu edit Select N&-M_first&+M_ed_a_f& Case M_ed_a_f& Return 1161 Case M_ed_a_n& Return 1177 Case M_ed_a_e& Return 1146 Case M_ed_a_b& Return 1176 Case M_ed_a_k& Return 1165 Case M_ed_c_v& Return 1022 Case M_ed_c_dl& Return 1031 Case M_ed_c_ch& Return 1199 Case M_ed_c_p& Return 1016 Case M_ed_a_c& Return 1174 Endselect ' Case 12 ! Graph ' Menu graph Select N&-M_first&+M_ed_a_f& Case M_gr_b& Return 10066 Case M_gr_a_b& Return 10176 Case M_gr_c& Return 10067 Case M_gr_a_c& Return 10174 Case M_gr_n& Return 10078 Case M_gr_p& Return 10080 Case M_gr_t& Return 10084 Case M_gr_a_t& Return 10148 Case M_gr_x& Return 10088 Case M_gr_i& Return 10073 Case M_gr_f& Return 10070 Case M_gr_e& Return 10069 Case M_gr_a_e& Return 10146 Case M_gr_c_h& Return 10008 Case M_gr_c_v& Return 10022 Case M_gr_l& Return 10076 Case M_gr_s& Return 10083 Endselect ' Case 13 ! Emul ' Menu emul Select N&-M_first&+M_ed_a_f& Case M_em_equ& ! basculer draw/‚mul Return 20147 Case M_em_tc& Return 20161 Case M_em_col& Return 20167 Case M_em_vdi& ! sto col Return 20666 Case M_em_ca& Return 20174 Case M_em_in& Return 20177 Case M_em_cls& Return 20146 ! cls Case M_em_40& Return 20052 ! 40 col Case M_em_80& Return 20056 ! 80 col Case M_em_on& Return 20152 ! curs on Case M_em_off& Return 20153 ! '' off Case M_em_spg& Return 20159 ! \S save Endselect ' Case 14 ! DRCS Select N&-M_first&+M_ed_a_f& Case Dr_tel& ! t‚l‚charger \T Return 30148 Case Dr_tel2& ! idem mais.. \E Return 30146 Case Dr_capt& ! capture? \C Return 30174 Case Dr_impj& ! Importer \M Return 30167 Case Dr_ldj& ! load \L Return 30166 Case Dr_ldj2& ! idem mais en slectionnant Return 30177 ! \iNsert Case Dr_svj& ! save \S Return 30159 Case Dr_svj2& Return 30172 ! \Write Case Dr_svt& ! save vdt Return 30175 ! \save vid‚oTex Case Dr_svt2& ! idem mais en selectionnant Return 30173 ! \eXport Case Dr_clr& ! Eff,\K Return 30165 Case Dr_dgt& ! Digitaliser \B Return 30176 ' Case Dr_g0& ! selection G0/G0',G1/G1' Return 30150 Case Dr_g0p& Return 30151 Case Dr_g1& Return 30152 Case Dr_g1p& Return 30153 Case Dg_parx& Return 30888 Endselect ' Case 44 ! Bitmap ' Select N&-M_first&+M_ed_a_f& Case Bt_load& Return 31076 Case Bt_ac& Return 31065 Case Bt_ifx& Return 31069 Case Bt_clr& Return 31128 Case Bt_last& Return 31013 Case Bt_parx& Return 31888 Endselect ' Endselect ! tester quel arbre d'objet a ‚t‚ sond‚!!!! ' Endselect ! fin 1er select $S% ' Return 0 Endfunc ' Procedure Rsrc_free Local E|,Flag! ' Flag!=False If Exadr%>0 ! MallocS If @Mfree(Exadr%)<>0 Flag!=True Endif Exadr%=-1 Endif ' If Dim?(Adr%()) If Adr%(Swicone&)>0 ~Rsrc_free() Endif Endif ' If Flag! ~@Form_alert(0,@Errf$(-40)) Endif ' Erase Rx&(),Ry&(),Rw&(),Rh&(),Adr%() ' @Popuninit ' Return Function Menu_oqp $F% Local E&,Flag! ' Flag!=False For E&=M_i& To M_ii&+1 If Btst(Ob_state(Menu_adr%,E&),0) Flag!=True Endif Next E& Return Flag! ' Endfunc ' Function Form_wdo(D%,B%) $F% Local A%,A&,B&,Mx&,My&,Mk&,Dummy&,Key&,Clic& Local Rx&,Ry&,Rw&,Rh& Local O& Local M&,N& Local A! Local X2&,Y2&,W2&,H2& ' X2&=Clip_x& Y2&=Clip_y& W2&=Clip_w& H2&=Clip_h& ' If Ob_type(Adr%(D%),1)=27 If Btst(Ob_state(Adr%(D%),1),4) If Wd_set! Ob_flags(Adr%(D%),1)=Bset(Ob_flags(Adr%(D%),1),7) Else Ob_flags(Adr%(D%),1)=Bclr(Ob_flags(Adr%(D%),1),7) Endif Endif Endif Clr Wd_incy& If Ob_type(Adr%(D%),2)=26 ! button ou boxchar If Btst(Ob_state(Adr%(D%),2),4) If Wd_set! Wd_incy&=Ob_y(Adr%(D%),2)+Ob_h(Adr%(D%),2) Ob_flags(Adr%(D%),2)=Bset(Ob_flags(Adr%(D%),2),7) If Not Wopen!(Wdial&) ~@Titlew(Wdial&,Char{Ob_spec(Adr%(D%),2)}+" ["+Name$+"]") Endif Else Ob_flags(Adr%(D%),2)=Bclr(Ob_flags(Adr%(D%),2),7) Endif Endif Else ~@Titlew(Wdial&,"Dialogue ["+Name$+"]") Endif ' If Wd_set! ' If B%=-3! restore ~@Wind_close(Wdial&) Else ' If Not Wopen!(Wdial&) Wd_do!=True Wd_id&=D% ! dial id ~Form_center(Adr%(Wd_id&),Rx&(Wd_id&),Ry&(Wd_id&),Rw&(Wd_id&),Rh&(Wd_id&)) Wset_x(Wdial&,Rx&(Wd_id&)) Wset_y(Wdial&,Ry&(Wd_id&)) Wset_w(Wdial&,Ob_w(Adr%(Wd_id&),0)) Wset_h(Wdial&,32) A!=Effect! Effect!=False ~@Wind_open(Wdial&) Effect!=A! Gosub Setxywh(Wdial&,W_ex&(Wdial&),W_ey&(Wdial&),Ob_w(Adr%(Wd_id&),0)+W_attrw&(Wdial&),Ob_h(Adr%(Wd_id&),0)+W_attrh&(Wdial&)-Wd_incy&) Endif ' If Wopen!(Wdial&) ' If B%<>-2 ! g‚rer ' ~@Wind_update01(0) A%=-1 Do ' Ob_x(Adr%(Wd_id&),0)=@Wxacoord(Wdial&,0) Ob_y(Adr%(Wd_id&),0)=@Wyacoord(Wdial&,-Wd_incy&) Rx&(Wd_id&)=Ob_x(Adr%(Wd_id&),0) Ry&(Wd_id&)=Ob_y(Adr%(Wd_id&),0) Select @Xfirstw Case Wdial& Case -1 Default @Xtop(Wdial&) Endselect ' Evnmnt&=Evnt_multi(&X110011,256+3,3,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),1000,Mx&,My&,Mk&,Dummy&,Key&,Clic&) ' If Wmenu&(0)=Wm_topped& Select @Windex(Wmenu&(3)) ! Index de fenˆtre? Case 0 To 6 Evnmnt&=Bclr(Evnmnt&,4) ! alors court circuiter! Endselect ! sinon (wdial etc) .. Endif ' If Btst(Evnmnt&,4) ! _Messag Reponse%=@Wmanage(True) ! True: tout g‚rer If Reponse%=-1 ! Au secour!!!! Set_end!=True A%=0 Exit if True Else if Reponse%=10 @Xtop(Wdial&) Void Menu_tnormal(Menu_adr%,Wmenu&(3),1) ' Gosub Msg_bra(Evnmnt&,Reponse%,False,False,False,False,False) Endif Else if Btst(Evnmnt&,0) Key&=@Geminp(Key&) Select Key& Case 17 @Beep Case 13 A&=0 Do ' A&=Ob_next(Adr%(Wd_id&),A&) Inc A& If Btst(Ob_flags(Adr%(Wd_id&),A&),1) Evnmnt&=Bset(Evnmnt&,1) ~Objc_offset(Adr%(Wd_id&),A&,Mx&,My&) Mk&=1 Endif Loop until Btst(Ob_flags(Adr%(Wd_id&),A&),5) ' Case 225,3 A&=0 Do ' A&=Ob_next(Adr%(Wd_id&),A&) Inc A& If Ob_type(Adr%(Wd_id&),A&)=26 $S% Select Left$(Char{Ob_spec(Adr%(Wd_id&),A&)},4) Case "ANNU","Annu","CANC","Canc" Evnmnt&=Bset(Evnmnt&,1) ~Objc_offset(Adr%(Wd_id&),A&,Mx&,My&) Mk&=1 Endselect $S& Endif Loop until Btst(Ob_flags(Adr%(Wd_id&),A&),5) ' Default ' If Wd_objc&>0 ' N&=Wd_objc& ' M&=Wd_curs& ' ' bjc_edit(Tree%,Ed_objc&,Key&,Ed_pos&,2,Ed_pos&) ! ‚dite le champ ' ~Objc_edit(Adr%(Wd_id&),Wd_objc&,Key&,M&,2,N&) ' If (M&<>Wd_objc& Or N&<>Wd_curs&) And M&<>0 ' Void Objc_edit(Adr%(Wd_id&),Wd_objc&,0,Wd_curs&,3,Wd_curs&) ! Efface curseur ' Void Objc_edit(Adr%(Wd_id&),N&,0,M&,2,Wd_curs&) ! Positionne curseur ' Void Objc_edit(Adr%(Wd_id&),N&,0,M&,3,Wd_curs&) ! Affiche le curseur ' Wd_objc&=N& ! Nouveau champ de texte ' Wd_curs&=M& ! Nouvelle position du curseur ' Endif ' Endif Endselect ' Endif ' If Btst(Evnmnt&,1) ! _Messag If Mk&>0 O&=Objc_find(Adr%(Wd_id&),0,7,Mx&,My&) If O&=>0 If Not Btst(Ob_state(Adr%(Wd_id&),O&),14) ! D‚placer formulaire ~Objc_offset(Adr%(Wd_id&),O&,Rx&,Ry&) If And(Ob_flags(Adr%(Wd_id&),O&),&X1001111)<>0 ! selectable (exit,texit,editable etc) ' For A&=0 To Npop&-1 If Popa%(A&)=Adr%(Wd_id&) If Popo&(A&)=O& P!=False ' ~@Wind_update01(1) Char{Ob_spec(Adr%(Wd_id&),O&)}=@Str_pop$(Pop$(A&),@Popdial(A&)) ! *** popdial *** Ob_state(Adr%(Wd_id&),O&)=Bclr(Ob_state(Adr%(Wd_id&),O&),0) ~Objc_draw(Adr%(Wd_id&),O&,7,Ob_x(Adr%(Wd_id&),0),Ob_y(Adr%(Wd_id&),0),Ob_w(Adr%(Wd_id&),0),Ob_h(Adr%(Wd_id&),0)) O&=-1 ~@Wind_update01(0) Exit if True ' Endif Endif Next A& ' If O&=>0 If And(Ob_flags(Adr%(Wd_id&),O&),&X1)<>0 If Btst(Ob_flags(Adr%(Wd_id&),O&),4) ! O&=radio-button B&=-1 A&=0 Do If (Ob_head(Adr%(Wd_id&),A&)<=O&) And (Ob_tail(Adr%(Wd_id&),A&)=>O&) If A&>B& ! meilleur encadrement B&=A& Endif Endif ' A&=Ob_next(Adr%(Wd_id&),A&) Inc A& Loop until Btst(Ob_flags(Adr%(Wd_id&),A&),5) ' Loop until A&>Ob_tail(Adr%(Wd_id&),0) ' if Not Btst(Ob_flags(Adr%(Wd_id&),A&),5) If B&=>0 For A&=Ob_head(Adr%(Wd_id&),B&) To Ob_tail(Adr%(Wd_id&),B&) If Btst(Ob_flags(Adr%(Wd_id&),A&),4) If Btst(Ob_state(Adr%(Wd_id&),A&),0) Ob_state(Adr%(Wd_id&),A&)=Bclr(Ob_state(Adr%(Wd_id&),A&),0) ~Objc_offset(Adr%(Wd_id&),A&,Rw&,Rh&) Gosub Rd_all(Wdial&,Rw&-2,Rh&-2,Ob_w(Adr%(Wd_id&),A&)+4,Ob_h(Adr%(Wd_id&),A&)+4) Endif Endif ' A&=Ob_next(Adr%(Wd_id&),A&) Next A& Endif Endif ' Ob_state(Adr%(Wd_id&),O&)=Bchg(Ob_state(Adr%(Wd_id&),O&),0) Gosub Rd_all(Wdial&,Rx&-2,Ry&-2,Ob_w(Adr%(Wd_id&),O&)+4,Ob_h(Adr%(Wd_id&),O&)+4) @Caremouse ' Else if Btst(Ob_flags(Adr%(Wd_id&),O&),3) Defmouse 1 ~Objc_offset(Adr%(Wd_id&),O&,Rx&,Ry&) Ob_flags(Adr%(Wd_id&),O&)=Bset(Ob_flags(Adr%(Wd_id&),O&),0) Ob_flags(Adr%(Wd_id&),O&)=Bset(Ob_flags(Adr%(Wd_id&),O&),2) Ob_state(Adr%(Wd_id&),O&)=Bset(Ob_state(Adr%(Wd_id&),O&),4) Gosub Rd_all(Wdial&,Rx&-4,Ry&-4,Ob_w(Adr%(Wd_id&),O&)+8,Ob_h(Adr%(Wd_id&),O&)+8) @W_rdexe @Caremouse A&=Byte(Form_do(Adr%(Wd_id&),O&)) Ob_flags(Adr%(Wd_id&),O&)=Bclr(Ob_flags(Adr%(Wd_id&),O&),0) Ob_flags(Adr%(Wd_id&),O&)=Bclr(Ob_flags(Adr%(Wd_id&),O&),2) Ob_state(Adr%(Wd_id&),O&)=Bclr(Ob_state(Adr%(Wd_id&),O&),4) Gosub Rd_all(Wdial&,Rx&-4,Ry&-4,Ob_w(Adr%(Wd_id&),O&)+8,Ob_h(Adr%(Wd_id&),O&)+8) If A&>1 ~Objc_offset(Adr%(Wd_id&),A&,Rx&,Ry&) Ob_state(Adr%(Wd_id&),A&)=Bclr(Ob_state(Adr%(Wd_id&),A&),0) Gosub Rd_all(Wdial&,Rx&-2,Ry&-2,Ob_w(Adr%(Wd_id&),A&)+4,Ob_h(Adr%(Wd_id&),A&)+4) Endif Defmouse 0 ' Endif ' If And(Ob_flags(Adr%(Wd_id&),O&),&X1000110)<>0 If Not Btst(Evnmnt&,0) N&=Graf_mkstate(Mx&,My&,Mk&,Dummy&) Endif If O&=Objc_find(Adr%(Wd_id&),0,7,Mx&,My&) A%=O& Else Ob_state(Adr%(Wd_id&),O&)=Bclr(Ob_state(Adr%(Wd_id&),O&),0) Gosub Rd_all(Wdial&,Rx&-2,Ry&-2,Ob_w(Adr%(Wd_id&),O&)+4,Ob_h(Adr%(Wd_id&),O&)+4) Endif Endif Endif ' Endif ! XYZselect Endif ! moving object Endif ! object detected! Endif Endif ' If Wopen!(Wdial&)=0 A%=1 ! cancel! Endif ' Loop until A%=>0 Endif ' Else A%=0 ! cancel! Endif Endif ' Else ' Return @Form_exdo(D%,B%) ' Endif ' Clip_x&=X2& Clip_y&=Y2& Clip_w&=W2& Clip_h&=W2& Gosub Reclip ' Wd_do!=False Return A% Endfunc ' ' Adresse, objet ; si objet=-2 alors simple dessin ; -3=restaurer ; 999=pas de moves Function Form_exdo(D%,B%) $F% Local A%,Z%,X%,Y%,N%,Adr2%,X2%,Y2% Local A& ' If Ob_type(Adr%(D%),1)=27 If Btst(Ob_state(Adr%(D%),1),4) Ob_flags(Adr%(D%),1)=Bclr(Ob_flags(Adr%(D%),1),7) Endif Endif If Ob_type(Adr%(D%),2)=26 ! button ou boxchar If Btst(Ob_state(Adr%(D%),2),4) Ob_flags(Adr%(D%),2)=Bclr(Ob_flags(Adr%(D%),2),7) Endif Endif ' Clip Off X2%=Ob_x(Adr%(D%),0)-Rx&(D%) Y2%=Ob_y(Adr%(D%),0)-Ry&(D%) Clr Adr2% ' If B%=-3 ! restore If (Exd%=D%) And (Exadr%>0) And Exdo!=False Gosub Aput(Rx&(D%),Ry&(D%),Exadr%) ~@Wind_update01(0) Else ~@Wind_update01(0) ~Form_dial(3,0,0,0,0,Rx&(D%),Ry&(D%),Rw&(D%),Rh&(D%)) Endif Exdo!=True If Exadr%>0 Void @Mfree(Exadr%) ! Lib‚rer Get/Put Exadr%=-1 Endif Clr A% Wmove(Rx&(D%),Ry&(D%),Rw&(D%),Rh&(D%),0,0,0,0) Else ~@Wind_update01(1) ! important If Exdo! Or B%=2 If Exadr%>0 ~@Mfree(Exadr%) Exadr%=-1 Endif ' ~Form_center(Adr%(D%),Rx&(D%),Ry&(D%),Rw&(D%),Rh&(D%)) Aget(Rx&(D%),Ry&(D%),Rw&(D%)+4,Rh&(D%)+4,Exadr%) Exd%=D% Wmove(0,0,0,0,Rx&(D%),Ry&(D%),Rw&(D%),Rh&(D%)) ~Objc_draw(Adr%(D%),0,255,Rx&(D%),Ry&(D%),Rw&(D%),Rh&(D%)) ' Endif ' Do If B%<>-2 ! g‚rer? If B%=999 A%=Form_do(Adr%(D%),0) Else A%=Form_do(Adr%(D%),B%) Endif ' Z%=Byte(A%) If B%<>999 If Btst(Ob_state(Adr%(D%),Z%),14) ! D‚placer formulaire If Btst(Ob_flags(Adr%(D%),Z%),6) ! D‚placer formulaire Z%=-1 If Not Btst(A%,15) ! not view Mouse X%,Y%,N% Gosub Defmouse(4) ~Graf_dragbox(Ob_w(Adr%(D%),0),Ob_h(Adr%(D%),0),Ob_x(Adr%(D%),0),Ob_y(Adr%(D%),0),X_desk&,Y_desk&,W_desk&-X2%-1,H_desk&-Y2%-1,X%,Y%) Gosub Defmouse(0) Else X%=Ob_x(Adr%(D%),0) Y%=Ob_y(Adr%(D%),0) Endif ' If @Xmousek<>3 ' Simple clic implique chang de coord If Imp(Not Btst(A%,15),X%<>Ob_x(Adr%(D%),0) Or Y%<>Ob_y(Adr%(D%),0)) @Lhidem ' Aget(Rx&(D%),Ry&(D%),Rw&(D%)-1,Rh&(D%)-1,Adr2%) ' If Exadr%>0 Gosub Aput(Rx&(D%),Ry&(D%),Exadr%) Else ~@Wind_update01(0) ~Form_dial(3,0,0,0,0,Rx&(D%),Ry&(D%),Rw&(D%),Rh&(D%)) Gosub W_rdexe ~@Wind_update01(1) Endif ' X%=Max(X%,X2%) Y%=Max(Y%,Y2%) ' Wmove(Ob_x(Adr%(D%),0),Ob_y(Adr%(D%),0),Ob_w(Adr%(D%),0),Ob_h(Adr%(D%),0),X%-X2%,Y%-Y2%,Ob_w(Adr%(D%),0),Ob_h(Adr%(D%),0)) ' Ob_x(Adr%(D%),0)=X% Ob_y(Adr%(D%),0)=Y% Rx&(D%)=X%-X2% Ry&(D%)=Y%-Y2% ' Aget(Rx&(D%),Ry&(D%),Rw&(D%)+4,Rh&(D%)+4,Exadr%) ' ' ~Evnt_timer(100) ' Gosub W_rdexe ' ~@Wind_update01(1) Waitmouse ! si view If Adr2%>0 Aput(Rx&(D%),Ry&(D%),Adr2%) Else ~Objc_draw(Adr%(D%),0,255,Rx&(D%),Ry&(D%),Rw&(D%),Rh&(D%)) Endif @Lshowm Endif ! changed? Endif ! abort ' Endif ! test Else For A&=0 To Npop&-1 If Popa%(A&)=Adr%(D%) If Popo&(A&)=Z% P!=False ' Char{Ob_spec(Adr%(D%),Z%)}=@Str_pop$(Pop$(A&),@Popdial(A&)) ! *** popdial *** Ob_state(Adr%(D%),Z%)=Bclr(Ob_state(Adr%(D%),Z%),0) ~Objc_draw(Adr%(D%),Z%,7,Ob_x(Adr%(D%),0),Ob_y(Adr%(D%),0),Ob_w(Adr%(D%),0),Ob_h(Adr%(D%),0)) Z%=-1 Exit if True ' Endif Endif Next A& Endif Endif ! test Else Clr Z% Exit if True Endif Loop until Z%=>0 If Btst(Ob_state(Adr%(D%),Z%),14) ! Closer! Ob_state(Adr%(D%),Z%)=Bclr(Ob_state(Adr%(D%),Z%),0) A%=0 ! 0=closer Endif If Exdo! Exdo!=False Endif If Adr2%>0 Void @Mfree(Adr2%) ! Lib‚rer Get/Put Adr2%=-1 Endif ' ~@Wind_update01(0) Endif ' Reclip ' Return A% Endfunc Procedure G_menu Local A%,X%,Y% Local A& ' X%=Mousex Y%=Mousey X%=Max(0,Min(Max(X_desk&,X%),W_desk&-Ob_w(Adr%(4),0))) Y%=Max(0,Min(Max(Y_desk&,Y%),H_desk&-Ob_h(Adr%(4),0))) Ob_x(Adr%(4),0)=X% Ob_y(Adr%(4),0)=Y% Rx&(4)=X% Ry&(4)=Y% ' Ob_state(Adr%(4),Rsc_gloupe&)=Bclr(Ob_state(Adr%(4),Rsc_gloupe&),0) ' Ob_state(Adr%(4),Rsc_gcadr0&)=Bclr(Ob_state(Adr%(4),Rsc_gcadr0&),0) ' Ob_state(Adr%(4),Rsc_gcadr1&)=Bclr(Ob_state(Adr%(4),Rsc_gcadr1&),0) ' Ob_state(Adr%(4),Rsc_gcadr2&)=Bclr(Ob_state(Adr%(4),Rsc_gcadr2&),0) If Coord! ' Ob_state(Adr%(4),Rsc_gloupe&)=Bset(Ob_state(Adr%(4),Rsc_gloupe&),0) Sel_pop(Adr%(4),Rsc_gcadr0&,2) Else Sel_pop(Adr%(4),Rsc_gcadr0&,1) Endif ' $S& ' Select Grill| ' Case 0 ' Ob_state(Adr%(4),Rsc_gcadr0&)=Bset(Ob_state(Adr%(4),Rsc_gcadr0&),0) ' Case 1 ' Ob_state(Adr%(4),Rsc_gcadr2&)=Bset(Ob_state(Adr%(4),Rsc_gcadr2&),0) ' Case 2 ' Ob_state(Adr%(4),Rsc_gcadr1&)=Bset(Ob_state(Adr%(4),Rsc_gcadr1&),0) ' Endselect ' $S% Sel_pop(Adr%(4),Rsc_gcadr0&,Grill|+1) ' ' Ob_state(Adr%(4),Rsc_gmog0&)=Bclr(Ob_state(Adr%(4),Rsc_gcadr0&),0) ' Ob_state(Adr%(4),Rsc_gmog1&)=Bclr(Ob_state(Adr%(4),Rsc_gcadr1&),0) ' Ob_state(Adr%(4),Rsc_gmog2&)=Bclr(Ob_state(Adr%(4),Rsc_gcadr2&),0) ' $S& ' Select Mog& ' Case 0 ' Ob_state(Adr%(4),Rsc_gmog0&)=Bset(Ob_state(Adr%(4),Rsc_gcadr0&),0) ' Case 1 ' Ob_state(Adr%(4),Rsc_gmog1&)=Bset(Ob_state(Adr%(4),Rsc_gmog1&),0) ' Case 2 ' Ob_state(Adr%(4),Rsc_gmog2&)=Bset(Ob_state(Adr%(4),Rsc_gmog2&),0) ' Endselect ' $S% Sel_pop(Adr%(4),Rsc_gmog0&,Mog&+1) ' ' ~Objc_draw(Adr%(4),0,255,Rx&(4),Ry&(4),Rw&(4),Rh&(4)) Exdo!=True A%=Byte(@Form_wdo(4,0)) Ob_state(Adr%(4),A%)=Bclr(Ob_state(Adr%(4),A%),0) ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(4),Ry&(4),Rw&(4),Rh&(4)) ~@Form_wdo(4,-3) ' ' If Btst(Ob_state(Adr%(4),Rsc_gloupe&),0) ' If Coord!=False ' ' ~Form_dial(3,0,0,0,0,W_ix&(2),W_iy&(2),W_iw&(2),W_ih&(2)) ' Rdw_all(2) ' Coord!=True ' Endif ' Else ' If Coord! ' ' ~Form_dial(3,0,0,0,0,W_ix&(2),W_iy&(2),W_iw&(2),W_ih&(2)) ' Rdw_all(2) ' Coord!=False ' Endif ' Endif A&=@State_pop(Adr%(4),Rsc_gloupe&) If (A&=2)<>Coord! Coord!=(A&=2) Rdw_all(2) Endif ' ' If Btst(Ob_state(Adr%(4),Rsc_gcadr0&),0) ' If Grill|<>0 ' ' ~Form_dial(3,0,0,0,0,W_ix&(2),W_iy&(2),W_iw&(2),W_ih&(2)) ' Rdw_all(2) ' Grill|=0 ' Endif ' Else if Btst(Ob_state(Adr%(4),Rsc_gcadr1&),0) ' If Grill|<>2 ' ' ~Form_dial(3,0,0,0,0,W_ix&(2),W_iy&(2),W_iw&(2),W_ih&(2)) ' Rdw_all(2) ' Grill|=2 ' Endif ' Else ' If Grill|<>1 ' ' ~Form_dial(3,0,0,0,0,W_ix&(2),W_iy&(2),W_iw&(2),W_ih&(2)) ' Rdw_all(2) ' Grill|=1 ' Endif ' Endif A&=@State_pop(Adr%(4),Rsc_gcadr0&)-1 If A&<>Grill| Grill|=A& Rdw_all(2) Endif ' ' If Btst(Ob_state(Adr%(4),Rsc_gmog0&),0) ' Mog&=0 ' Else if Btst(Ob_state(Adr%(4),Rsc_gmog1&),0) ' Mog&=1 ' Else if Btst(Ob_state(Adr%(4),Rsc_gmog2&),0) ' Mog&=2 ' Endif Mog&=@State_pop(Adr%(4),Rsc_gmog0&)-1 ' Gosub W_rdexe ' Clr Key& ' $S& Select A% Case Rsc_gbox& Key&=Asc("B") Case Rsc_gfbox& Key&=176 Case Rsc_gcircle& Key&=Asc("C") Case Rsc_gfcircle& Key&=174 Case Rsc_gline& Key&=Asc("N") Case Rsc_gbez& Key&=Asc("P") Case Rsc_gtxt& Key&=Asc("T") Case Rsc_gdeftxt& Key&=148 Case Rsc_gfclr& Key&=146 Case Rsc_gclr& Key&=Asc("E") Case Rsc_gfill& Key&=Asc("F") Case Rsc_ginv& Key&=Asc("I") Case Rsc_ghflip& Gosub Rotate(1) Case Rsc_gvflip& Gosub Rotate(2) Case Rsc_gbrush& Key&=Asc("X") Case Rsc_gload& Key&=Asc("L") Case Rsc_gsave& Key&=Asc("S") Case Rsc_gdefloupe& Coord!=True Gosub Loupe ' Case Rsc_gcancel& Endselect $S% ' If Key&<>0 @Selectgrf(Key&) Endif ' Return ' Function Rinput$(E$,A$) Local A% ' Char{Ob_spec(Adr%(3),Rsc_nty&)}=E$ Char{{Ob_spec(Adr%(3),Rsc_nt&)}}=A$ ' ~Objc_draw(Adr%(3),0,255,Rx&(3),Ry&(3),Rw&(3),Rh&(3)) Exdo!=True A%=Byte(@Form_exdo(3,0)) ~@Wind_update01(0) Ob_state(Adr%(3),A%)=Bclr(Ob_state(Adr%(3),A%),0) If A%=Rsc_nok& E$=Char{{Ob_spec(Adr%(3),Rsc_nt&)}} Else Clr E$ Endif ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(3),Ry&(3),Rw&(3),Rh&(3)) ~@Form_exdo(3,-3) Exdo!=True @W_rdexe Return E$ Endfunc ' Procedure Rshow(E$,A$) Local A% ' E$=Left$(E$,64) A$=Left$(A$,64) A$=A$+Space$(64-Len(A$)) Ob_flags(Adr%(3),Rsc_nca&)=Bset(Ob_flags(Adr%(3),Rsc_nca&),7) Ob_flags(Adr%(3),Rsc_nt&)=Bclr(Ob_flags(Adr%(3),Rsc_nt&),3) Char{Ob_spec(Adr%(3),Rsc_nty&)}=E$ Char{{Ob_spec(Adr%(3),Rsc_nt&)}}=A$ Exdo!=True A%=Byte(@Form_exdo(3,0)) Ob_state(Adr%(3),A%)=Bclr(Ob_state(Adr%(3),A%),0) ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(3),Ry&(3),Rw&(3),Rh&(3)) ~@Form_exdo(3,-3) Exdo!=True @W_rdexe Ob_flags(Adr%(3),Rsc_nca&)=Bclr(Ob_flags(Adr%(3),Rsc_nca&),7) Ob_flags(Adr%(3),Rsc_nt&)=Bset(Ob_flags(Adr%(3),Rsc_nt&),3) Return ' Barre d'infos (en bas) Procedure Rqshow(A$) ' If Rquick%>0 Rquick%=-1 ' ~@Form_exdo(28,-3) ' @W_rdexe Endif ' A$=Left$(A$,64) A$=A$+Space$(64-Len(A$)) Char{{Ob_spec(Adr%(28),1)}}=A$ ~Objc_draw(Adr%(28),0,7,Rx&(28),Ry&(28),Rw&(28),Rh&(28)) ' Gosub Rq_drw ! dessiner info Rquick%=Timer ' Return ' Afficher un moment info Procedure Rq_time(Flag!) If Rquick%>0 If Timer>Rquick%+400 Or Flag! If Not @Menu_oqp ! menu non oqp? (select) Rquick%=-1 ~Form_dial(3,0,0,0,0,Rx&(28),Ry&(28)-1,Rw&(28),Rh&(28)+2) ' ~@Form_exdo(28,-3) @W_rdexe Else Rquick%=1 ! wait.. Endif Endif Endif Return Procedure Rq_drw Local A%,X%,Y%,W%,H%,Rx&,Ry&,Rw&,Rh& ' X%=Rx&(28) Y%=Rx&(28) W%=Rx&(28) H%=Rx&(28) @Hidem ~@Wind_update01(1) ~Wind_get(Whandle&(Index&),11,Rx&,Ry&,Rw&,Rh&) While Rw&>0 ' If Rc_intersect(X%,Y%,W%,H%,Rx&,Ry&,Rw&,Rh&) ~Objc_draw(Adr%(28),0,&HFF,Rx&,Ry&,Rw&,Rh&) Gosub Redraw(Index&,Rx&,Ry&,Rw&,Rh&) Endif ~Wind_get(Whandle&(Index&),12,Rx&,Ry&,Rw&,Rh&) ' Wend ~@Wind_update01(0) @Showm Return ' ' Show box/hide Procedure Fmshow(E$) Exdo!=True ' ' ~Evnt_timer(100) ' ' Gosub W_rdexe Char{{Ob_spec(Adr%(33),Fi_text&)}}=Left$(E$,38)+".." ' ~Objc_draw(Adr%(33),0,7,Rx&(33),Ry&(33),Rw&(33),Rh&(33)) ~@Form_exdo(33,-2) ! dessiner Return Procedure Fmhide ' ~Form_dial(3,0,0,0,0,Rx&(33),Ry&(33),Rw&(33),Rh&(33)) ~@Form_exdo(33,-3) ! restaurer ' 'Gosub W_rdexe Return ' ' Wind_popup Function Pop_win(T%,L&,X&,Y&) $F% Local X2&,Y2&,K&,A&,N&,W&,H&,A!,Flag! ' If Mousek<>0 A!=True Else A!=False X&=Max(X_desk&,X&-Rw&(T%)\2) Y&=Max(Y_desk&,Y&-Rh&(T%)\2) Endif Exdo!=True ~@Wind_update01(1) W&=Rx&(T%)-Ob_x(Adr%(T%),0) H&=Ry&(T%)-Ob_y(Adr%(T%),0) X&=Max(X&,X_desk&+2) Y&=Max(Y&,Y_desk&+2) X&=Min(X&,W_desk&+X_desk&-Ob_w(Adr%(T%),0)-2) Y&=Min(Y&,H_desk&+Y_desk&-Ob_h(Adr%(T%),0)-2) Ob_x(Adr%(T%),0)=X& Ob_y(Adr%(T%),0)=Y& Rx&(T%)=X&+W& Ry&(T%)=Y&+H& Clr N& For A&=1 To L& Ob_state(Adr%(T%),A&)=Bclr(Ob_state(Adr%(T%),A&),0) Next A& ~Objc_draw(Adr%(T%),0,7,Rx&(T%),Ry&(T%),Rw&(T%),Rh&(T%)) Gosub Defmouse(3) Do Mouse X2&,Y2&,K& Flag!=True For A&=1 To L& If Btst(Ob_flags(Adr%(T%),A&),6) If Not Btst(Ob_state(Adr%(35),A&),3) If X2&>Ob_x(Adr%(T%),0)+Ob_x(Adr%(T%),A&) If Y2&>Ob_y(Adr%(T%),0)+Ob_y(Adr%(T%),A&) If X2&A& If N&>0 Ob_state(Adr%(T%),N&)=Bclr(Ob_state(Adr%(T%),N&),0) ~Objc_draw(Adr%(T%),N&,7,Rx&(T%),Ry&(T%),Rw&(T%),Rh&(T%)) Endif N&=A& Ob_state(Adr%(T%),A&)=Bset(Ob_state(Adr%(T%),A&),0) ~Objc_draw(Adr%(T%),A&,7,Rx&(T%),Ry&(T%),Rw&(T%),Rh&(T%)) Endif Endif Endif Endif Endif Endif Endif Next A& ' If Flag! If X2&=>Ob_x(Adr%(T%),0) If Y2&=>Ob_y(Adr%(T%),0) If X2&<=Ob_x(Adr%(T%),0)+Ob_w(Adr%(T%),0) If Y2&<=Ob_y(Adr%(T%),0)+Ob_h(Adr%(T%),0) Flag!=False Endif Endif Endif Endif Endif If Flag! If N&>0 Ob_state(Adr%(T%),N&)=Bclr(Ob_state(Adr%(T%),N&),0) ~Objc_draw(Adr%(T%),N&,7,Rx&(T%),Ry&(T%),Rw&(T%),Rh&(T%)) Clr N& Endif Endif ' Loop until (K&=0)=A! Or (Flag! And Not A!) If N&>0 For A&=1 To 5 Ob_state(Adr%(T%),N&)=Bchg(Ob_state(Adr%(T%),N&),0) ~Objc_draw(Adr%(T%),N&,7,Rx&(T%),Ry&(T%),Rw&(T%),Rh&(T%)) ~Evnt_timer(50) Next A& Endif Gosub Defmouse(0) ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(T%),Ry&(T%),Rw&(T%),Rh&(T%)) ~@Form_exdo(T%,-3) ' Return N& Endfunc ' Procedure Pop_x Local N&,Ha&,A&,B& ' Ha&=@Xfirstw If Ha&=>0 If (Not Btst(Wflag%(Ha&),1)) And (And(Wxflag%(Ha&),&X110)=0) Ha&=-1 Endif Endif If Ha&<0 For A&=6 To 9 Ob_state(Adr%(35),A&)=Bset(Ob_state(Adr%(35),A&),3) Next A& Else For A&=6 To 9 Ob_state(Adr%(35),A&)=Bclr(Ob_state(Adr%(35),A&),3) Next A& Endif N&=@Pop_win(35,9,Mousex,Mousey) $S& Select N& Case 1 ! editeur ~@Wind_open(0) If Wopen!(0) @Top(0) Endif Case 2 ! graphique ~@Wind_open(2) If Wopen!(2) @Top(2) Endif Case 3 ! ‚mulateur ~@Wind_open(4) If Wopen!(4) @Top(4) Endif Case 4 ! ed. drcs ~@Wind_open(5) If Wopen!(5) @Top(5) Endif Default If Ha&=>0 $S& Select N& Case 6 If Btst(Wxflag%(Ha&),1) Gosub Smaller(Ha&,True) Gosub Setfulled(Ha&) Else Gosub Setfulled(Ha&) Endif Case 7 If Btst(Wxflag%(Ha&),1) Gosub Smaller(Ha&,True) Gosub Setfscreen(Ha&) Else Gosub Setfscreen(Ha&) Endif ' Endif Case 8 If Btst(Wflag%(Ha&),2) Or Btst(Wxflag%(Ha&),2) If Not Btst(Wxflag%(Ha&),1) ' If Not Btst(@Shift,2) Gosub Smaller(Ha&,True) Ha&=@Firstns If Ha&=>0 @Xtop(Ha&) Endif ' ' Else ' ..Smaller pour toutes les fenˆtres Clr B& For A&=0 To Nbr_idxw& If Btst(Wflag%(A&),14) ! Smaller? If Wopen!(A&) If Not Btst(Wxflag%(A&),1) Smaller(A&,True) Endif Setxywh(A&,X_desk&+2,Y_desk&+B&*(W_attrh&(A&)+2),W_ew&(A&),W_eh&(A&)) @Xtop(A&) Inc B& Endif Else If Btst(Wxflag%(A&),1) Setxywh(A&,X_desk&+2,Y_desk&+B&*(W_attrh&(A&)+2),W_ew&(A&),W_eh&(A&)) @Xtop(A&) Inc B& Endif Endif Next A& ' Endif ' Else Gosub Smaller(Ha&,True) Endif Endif Case 9 If Btst(Wflag%(Ha&),1) Or (And(Wxflag%(Ha&),&X110)<>0) ! Fermable? ~@Wind_close(Ha&) Endif Endselect Endif Endselect $S% ' Return ' Procedure Coord(X%,Y%) Local Mx%,My%,B%,C%,Vididx&,X2%,Y2%,W%,H% ' ~@Wind_update01(1) If Coord! If X%=>W_ix&(2) And Y%=>W_iy&(2) And X%<=W_ix&(2)+320 And Y%<=W_iy&(2)+150 ' X%=@Wxrcoord(2,X%-2) Y%=@Wyrcoord(2,Y%-2) Div X%,4 Div Y%,2 X%=Max(0,Min(X%,79)) Y%=Max(0,Min(Y%,74)) Inc X% Inc Y% If Acx&<>X% Or Acy&<>Y% Or Lp_draw!=False Acx&=X% Acy&=Y% ! sauver old coord ' @Lhidem Wind_clip(2) ! clipping fenˆtre If Lp_draw!=False ! la loupe est effac‚e Gosub Deffillcol(0) Gosub Pbox(@Wxacoord(2,326),@Wyacoord(2,0),@Wxacoord(2,W_desk&),@Wyacoord(2,H_desk&)) Mx%=@Wxacoord(2,Lp_px&) My%=@Wyacoord(2,Lp_py&) Gosub Color(Col1&) @Gbox(Mx%,My%,Mx%+((Lp_zx&+1)*Lp_mx&*2),My%+((Lp_zy&+1)*Lp_my&*3)) ' Box Mx%-1,My%-1,Mx%+((Lp_zx&+1)*Lp_mx&*2)+1,My%+((Lp_zy&+1)*Lp_my&*3)+1 ' Box Mx%-2,My%-2,Mx%+((Lp_zx&+1)*Lp_mx&*2)+2,My%+((Lp_zy&+1)*Lp_my&*3)+2 ' Box Mx%-4,My%-4,Mx%+((Lp_zx&+1)*Lp_mx&*2)+4,My%+((Lp_zy&+1)*Lp_my&*3)+4 Lp_draw!=True ! ok, dessin‚e Endif Wtext(2,340,Ccsizey&,"XCoord "+Str$(X%,2)+" YCoord "+Str$(Y%,2)+" ") ' Mx%=(X%-1)\2 My%=(Y%-1)\3 B%=Mx% C%=My% ' X2%=X% Y2%=Y% ' Mx%=@Wxacoord(2,Lp_px&) My%=@Wyacoord(2,Lp_py&) Gosub Deffillcol(0) Gosub Pbox(Mx%,My%,Mx%+((Lp_zx&+1)*Lp_mx&*2),My%+((Lp_zy&+1)*Lp_my&*3)) Gosub Deffillcol(Colg&) For Y%=C%-(Lp_zy&\2) To C%+(Lp_zy&\2) For X%=B%-(Lp_zx&\2) To B%+(Lp_zx&\2) Mx%=@Wxacoord(2,Lp_px&+(X%-B%+(Lp_zx&\2))*Lp_mx&*2) My%=@Wyacoord(2,Lp_py&+(Y%-C%+(Lp_zy&\2))*Lp_my&*3) If X%=>0 And Y%=>0 And X%<40 And Y%<25 Vididx&=Y%*40+X%+1 A%=Asc(Mid$(Vid$,Vididx&,1)) If Btst(A%,0) Gosub Pbox(Mx%,My%,Mx%+Lp_mx&-1,My%+Lp_my&-1) Endif If Btst(A%,1) Gosub Pbox(Mx%+Lp_mx&,My%,Mx%+Lp_mx&*2-1,My%+Lp_my&-1) Endif If Btst(A%,2) Gosub Pbox(Mx%,My%+Lp_my&,Mx%+Lp_mx&-1,My%+Lp_my&*2-1) Endif If Btst(A%,3) Gosub Pbox(Mx%+Lp_mx&,My%+Lp_my&,Mx%+Lp_mx&*2-1,My%+Lp_my&*2-1) Endif If Btst(A%,4) Gosub Pbox(Mx%,My%+Lp_my&*2,Mx%+Lp_mx&-1,My%+Lp_my&*3-1) Endif If Btst(A%,5) Gosub Pbox(Mx%+Lp_mx&,My%+Lp_my&*2,Mx%+Lp_mx&*2-1,My%+Lp_my&*3-1) Endif Else Gosub Deffill(Col1&,2,4) Gosub Pbox(Mx%,My%,Mx%+Lp_mx&*2-1,My%+Lp_my&*3-1) Gosub Deffill(Colg&,1,1) Endif Next X% Next Y% ' Mx%=@Wxacoord(2,Lp_px&) My%=@Wyacoord(2,Lp_py&) X%=Mod((X2%-1),2) Y%=Mod((Y2%-1),3) Gosub Color(Col1&) Graphmode (3) Gosub Box(Mx%+(Lp_zx&\2)*Lp_mx&*2,My%+(Lp_zy&\2)*Lp_my&*3,Mx%+(Lp_zx&\2+1)*Lp_mx&*2,My%+(Lp_zy&\2+1)*Lp_my&*3) Graphmode ($ And And And And Imp $ And Atn( Or Time$ And Sin(Mx%+X%*Lp_mx&+(Lp_zx&\2)*Lp_mx&*2 X2%=Mx%+X%*Lp_mx&+(Lp_zx&\2)*Lp_mx&*2 Y2%=My%+Y%*Lp_my&+(Lp_zy&\2)*Lp_my&*3 W%=Mx%+(X%+1)*Lp_mx&+(Lp_zx&\2)*Lp_mx&*2 H%=My%+(Y%+1)*Lp_my&+(Lp_zy&\2)*Lp_my&*3 Gosub Box(X2%,Y2%,W%,H%) Gosub Line(X2%,Y2%,W%,H%) Gosub Line(W%,Y2%,X2%,H%) Graphmode (3) Gosub Pbox(X2%+((W%-X2%)\2)-1,Y2%+((H%-Y2%)\2)-1,X2%+((W%-X2%)\2)+1,Y2%+((H%-Y2%)\2)+1) Graphmode (1) @Lshowm ' Else Acx&=X% Acy&=Y% ! sauver old coord Endif Else @Lhidem Wind_clip(2) ! clipping fenˆtre Wtext(2,340,Ccsizey&,"XCoord ?? YCoord ?? ") Mx%=@Wxacoord(2,Lp_px&) My%=@Wyacoord(2,Lp_py&) Gosub Deffillcol(0) Gosub Pbox(Mx%,My%,Mx%+((Lp_zx&+1)*Lp_mx&*2),My%+((Lp_zy&+1)*Lp_my&*3)) Gosub Color(Col1&) Gosub Line(Mx%,My%,Mx%+((Lp_zx&+1)*Lp_mx&*2),My%+((Lp_zy&+1)*Lp_my&*3)) Gosub Line(Mx%,My%+((Lp_zy&+1)*Lp_my&*3),Mx%+((Lp_zx&+1)*Lp_mx&*2),My%) Gosub Box(Mx%-1,My%-1,Mx%+((Lp_zx&+1)*Lp_mx&*2)+1,My%+((Lp_zy&+1)*Lp_my&*3)+1) Gosub Box(Mx%-2,My%-2,Mx%+((Lp_zx&+1)*Lp_mx&*2)+2,My%+((Lp_zy&+1)*Lp_my&*3)+2) Gosub Box(Mx%-4,My%-4,Mx%+((Lp_zx&+1)*Lp_mx&*2)+4,My%+((Lp_zy&+1)*Lp_my&*3)+4) @Lshowm Endif Endif ~@Wind_update01(0) Return ' Procedure Loupe Local Mx&,My&,Mk&,A& ' Gosub W_rdexe Wind_clip(2) ! clipping fenˆtre Gosub Deffillcol(0) Gosub Pbox(@Wxacoord(2,326),@Wyacoord(2,0),@Wxacoord(2,W_desk&),@Wyacoord(2,H_desk&)) Lp_draw!=False ' @Waitmouse @Caremouse ~@Wind_update01(1) Gosub Defmouse(7) ~@Infow(2,"Clic g: coin sup.g. de la loupe/ Clic d: annuler") Clr Mx&,My&,Mk& Graphmode (3) @Lhidem Do ~Evnt_timer(20) ~Graf_mkstate(Mx&,My&,Mk&,A&) If @Wyrcoord(2,My&)<160 Mx&=Max(@Wxrcoord(2,Mx&),334) Endif My&=Max(@Wyrcoord(2,My&),Ccsizey&+8) Gosub Line(@Wxacoord(2,Mx&),@Wyacoord(2,My&),@Wxacoord(2,Mx&)+W_desk&,@Wyacoord(2,My&)) Gosub Line(@Wxacoord(2,Mx&),@Wyacoord(2,My&),@Wxacoord(2,Mx&),@Wyacoord(2,My&+H_desk&)) ~Evnt_timer(20) Gosub Line(@Wxacoord(2,Mx&),@Wyacoord(2,My&),@Wxacoord(2,Mx&)+W_desk&,@Wyacoord(2,My&)) Gosub Line(@Wxacoord(2,Mx&),@Wyacoord(2,My&),@Wxacoord(2,Mx&),@Wyacoord(2,My&+H_desk&)) Loop until Mk&<>0 @Lshowm ' @Waitmouse If Mk&=1 Lp_px&=Mx& Lp_py&=My& ! Noter coord loupe! ' ~@Infow(2,"D‚finir la taille d'un point - Clic pour confirmer") @Lhidem Do ~Evnt_timer(20) ~Graf_mkstate(Mx&,My&,Mk&,A&) Mx&=Max(1,@Wxrcoord(2,Mx&-Lp_px&)) My&=Max(1,@Wyrcoord(2,My&-Lp_py&)) Gosub Box(@Wxacoord(2,Lp_px&),@Wyacoord(2,Lp_py&),@Wxacoord(2,Lp_px&+Mx&),@Wyacoord(2,Lp_py&+My&)) ~Evnt_timer(20) Gosub Box(@Wxacoord(2,Lp_px&),@Wyacoord(2,Lp_py&),@Wxacoord(2,Lp_px&+Mx&),@Wyacoord(2,Lp_py&+My&)) Graphmode (1) Wtext(2,340,Ccsizey&,"Taille d'un point: X: "+Str$(Mx&)+" * Y: "+Str$(My&)+" pts ") Graphmode (3) Loop until Mk&<>0 @Lshowm Lp_mx&=Mx& Lp_my&=My& ! noter taillle cellules ' @Waitmouse ~@Infow(2,"D‚finir la taille de la loupe - Clic pour confirmer") @Lhidem Do ~Evnt_timer(20) ~Graf_mkstate(Mx&,My&,Mk&,A&) Mx&=@Wxrcoord(2,(Mx&-Lp_px&))\Lp_mx&*2+1 My&=@Wyrcoord(2,(My&-Lp_py&))\Lp_my&*3+1 Mx&=Max(2,(Mx&\2)*2) My&=Max(2,(My&\2)*2) Gosub Box(@Wxacoord(2,Lp_px&),@Wyacoord(2,Lp_py&),@Wxacoord(2,Lp_px&+(Mx&+1)*Lp_mx&*2),@B!2,Lp_py&+(My&+1)*Lp_my&*3)) ~Evnt_timer(20) Gosub Box(@Wxacoord(2,Lp_px&),@Wyacoord(2,Lp_py&),@Wxacoord(2,Lp_px&+(Mx&+1)*Lp_mx&*2),@Wyacoord(2,Lp_py&+(My&+1)*Lp_my&*3)) Loop until Mk&<>0 @Lshowm ' Lp_zx&=Mx& Lp_zy&=My& ! noter nombre de cellules ' Endif Graphmode (1) Gosub Defmouse(0) ~@Wind_update01(0) ' Clip_off @Waitmouse Return ' ' Infos pour menu & drcs Procedure Menu.info(E$) ~@Infow(1,E$) Menu_time!=False If Not Wopen!(1) Gosub Rqshow(E$) Endif Return Procedure Eminfo(E$) Local A& ' If Len(E$)>0 ' @Lprintl(E$) ' Print At(1,1);E$,,,, ~@Infow(4,E$) If Mid$(Em$(0),11)<>E$ ! hh:mm:ss> XX Insert Em$(0)=Time$+"> "+E$ Else Em$(0)=Time$+"> "+E$ Endif ' Em_2$=Em_1$ ' Em_1$=E$ If Wopen!(4) Clip(W_ix&(4),W_iy&(4),W_iw&(4)-1,W_ih&(4)-1) @Deffillcol(0) @Graphmode(1) Gosub Pbox(@Wxacoord(4,Emx&),@Wyacoord(4,Emy&+(Vmax_y&+2)*Eccsizey&),@Wxacoord(4,Emx&+(Vmax_x&+1)*Eccsizex&),@Wyacoord(4,Emy&+(Vmax_y&+2)*Eccsizey&+Ccsizey&*4)) @Sweety_text Deftext 1 @Deffillcol(1) For A&=0 To 3 @Wtext(4,Emx&,Emy&+Vmax_y&*Eccsizey&+(3+A&)*Ccsizey&,Em$(A&)) Next A& ' @Wtext(4,Emx&,Emy&+(Vmax_y&+4)*Eccsizey&,"> "+Em_2$) If Clip_x&=>0 Clip Clip_x&,Clip_y&,Clip_w&,Clip_h& Else Clip Off Endif Endif Else @Sweety_text Deftext 1 For A&=0 To 3 @Wtext(4,Emx&,Emy&+Vmax_y&*Eccsizey&+(3+A&)*Ccsizey&,Em$(A&)) Next A& ' @Wtext(4,Emx&,Emy&+(Vmax_y&+3)*Eccsizey&,"> "+Em_1$) ' @Wtext(4,Emx&,Emy&+(Vmax_y&+4)*Eccsizey&,"> "+Em_2$) Endif Return ' Procedure Emstat Local E$,N& ' If Not Set_minid! Clr E$ ' N&=Byte(Div(Ccurs&,&H100)) If N&=>0 And N&<=7 E$=E$+"Col "+Col$(0,Intercol&(N&)) Else E$=E$+"Col "+Str$(N&) Endif ' N&=Byte(Ccurs&) If N&=>0 And N&<=7 E$=E$+",Fnd "+Col$(0,Intercol&(N&)) Else E$=E$+",Fnd "+Str$(N&) Endif ' If Emulm|=0 E$="Vdt "+E$ E$=E$+"," ' $S& Select Tcurs| Case 0 E$=E$+"Norm" Case 1 E$=E$+"Haut" Case 2 E$=E$+"Large" Case 3 E$=E$+"DTaille" Endselect $S% ' E$=E$+"," If Btst(Acurs|,0) E$=E$+"C" Else E$=E$+"_" Endif If Btst(Acurs|,1) E$=E$+"L" Else E$=E$+"_" Endif If Btst(Acurs|,2) E$=E$+"M" Else E$=E$+"_" Endif If Btst(Acurs|,3) E$=E$+"I" Else E$=E$+"_" Endif If Btst(Acurs|,4) E$=E$+"G" Else E$=E$+"T" Endif ' E$=E$+"," If Rmode! E$=E$+"R" Else E$=E$+"_" Endif If Vmode! E$=E$+Chr$(3) Else E$=E$+"_" Endif ' If Special&=&HFE ! Vdt special? E$=E$+" Loading.." Endif ' Else E$="80col "+E$ Endif ' E$="Status: X="+Str$(X_curs&+1,2)+" Y="+Str$(Y_curs&,2)+" "+E$ ' Else E$="Segments positionn‚s: "+Str$(Len(Minid$)\8) Endif ' ~@Infow(Index&,E$) Return ' Procedure Exec(E$) Local A&,P%,A%,D& Local T$,A$ ' If @Exist(E$) E$=E$+Mki$(0) Select Mid$(E$,Len(E$)-4,3) Case "TTP","APP" A$=@Rinput$("ParamŠtres:","")+Mki$(0) Default A$=Mki$(0) Endselect ' If Menu_adr%>0 Menu_close Gosub Rsrc_free Menu_adr%=&HFF Endif ' Gosub Defmouse(2) P%=&H0 A%=Gemdos(75,3,L:V:E$,L:V:A$,L:V:P%) ! Charger et reloger Gosub Defmouse(0) If A%>0 ' Gosub Wind_keep(T$) ! fermer fenˆtres et noter place ' Gosub Defmouse(2) @Hidem ' @Print(Chr$(27)+"E") Select Mid$(E$,Len(E$)-4,3) Case "TOS","TTP" @Hidem @Printl("> "+E$) @Printl(Chr$(27)+"e") @Print(Chr$(27)+"q") Default ~Form_dial(3,0,0,0,0,X_desk&,Y_desk&,W_desk&,H_desk&) @W_rdexe ~Fre(0) Defmouse 2 @Showm Endselect ' ' Chdrive Left$(E$,1) ' Chdir E$ ' A$=Mkl$(A%)+Mki$(0) ' A&=Gemdos(75,4,L:V:P%,L:V:A$,L:V:P%) A$=String$(512,0) E$=@Trimasc$(Left$(E$,Rinstr(E$,"\")))+Mki$(0) D&=Gemdos(25) ! Get drive ~Gemdos(71,L:V:A$,0) ! Get path $S& Select Left$(E$,1) Case "A" To "Z" ~Gemdos(14,Asc(Left$(E$,1))-64) ! Set drive Endselect $S% ~Gemdos(59,L:V:E$) ! Set ProgPath ' --------------------------------------- A&=Gemdos(75,4,L:V:P%,L:A%,L:V:P%) ! Run! ' --------------------------------------- ~Gemdos(14,D&) ! Set drive ~Gemdos(59,L:V:A$) ! Set path ' @Print(Chr$(27)+"E") @Showm Gosub Defmouse(0) ' Chdrive Nom_prg$ ' Chdir Nom_prg$ ' ~@Mfree(A%) ! unreserve A%=-1 ' If A&<0 ~@Form_alert(1,@Errf$(A&)) Else if A&>0 ~@Form_alert(1,"[1][|Retour de programme: |ErrCode="+Str$(A&)+"|][ Ok? ]") Endif Defmouse 0 ' Endif ' Gosub Defmouse(2) If Menu_adr%=&HFF Gosub Rsrc_load Endif ' If A%>0 @Hidem @Print(Chr$(27)+"E") @Printl(Chr$(27)+"f") ~Form_dial(3,0,0,0,0,X_desk&,Y_desk&,W_desk&,H_desk&) W_rdexe ' If Menu_adr%>0 ! redessiner menu? Menu_open Endif ' Gosub Defmouse(0) @Showm Videkbd ' Gosub Wind_rest(T$) ! restaurer winds ' Endif ' Else @Showm ~@Form_alert(1,@Errf$(-33)) Endif ! trouv‚? ' Return ' ' keep/rest window pos and close Procedure Wind_keep(Var T$) Local Boucl& ' @Hidem Wmove(0,0,W_desk&,H_desk&,W_desk&\2,H_desk&\2,1,1) Clr T$ For Boucl&=Nbr_idxw& Downto 0 If Wopen!(Boucl&) If @Tstwork(Boucl&) T$=T$+Mki$(Boucl&) Else T$=T$+Mki$(-1) Endif ~@Wind_hideclose(Boucl&) ! 9ø Gosub W_rdexe Else T$=T$+Mki$(-1) Endif Next Boucl& Return Procedure Wind_rest(T$) Local Boucl& ' For Boucl&=Nbr_idxw& Downto 0 A&=Word(Cvi(Left$(T$,2))) T$=Mid$(T$,3) If A&=>0 ~@Wind_open(Boucl&) ! 9ø Gosub W_rdexe Endif Next Boucl& Return ' Procedure Allfree Local T$,E$,A$,B$ Local Resultat# Local X& Local L%,P%,N% ! len, pos, iNcr‚ment Local Boucl& ' If @Red_alert(1,"[3][|"+"Cette op‚ration efface tous |les travaux ‚dit‚s en m‚moire|"+"M‚moire|][Confirmer| Annuler ]")=1 ' $S& Select Form_alert(1,"[3][Vous pouvez d‚finir le nombre|de lignes maximum de l'‚diteur|ou bien choisir la place |m‚moire r‚serv‚e par Sweetel2][Nb. lignes|Place m‚m.]") Case 1 ~Fre(0) X&=Min(32000,(Fre()-Limit%)\40+Dims&) T$=Str$(Dims&) Do @W_rdexe T$=@Rinput$("Nombre de lignes: (100.."+Str$(X&)+")",T$) T$=@Epure$(T$) If Len(T$)>0 Clr E$ Div0%=False Resultat#=@Analyste(T$,E$) If Len(E$)=0 And Frac(Resultat#)=0 A%=Int(Resultat#) If A%=>99 And A%<=X& Exit if True Else If @Form_alert(1,"[1][|D‚passement de limites! |][Re-essayer| Annuler ]")=2 A%=0 Exit if True Else Beep Endif Endif Else Beep Endif Else A%=0 Exit if True Endif Loop @Videkbd ' ' B%=((A%*66)+(4*10000)+10000) ' X%=Mem%-256 ' Do ' $S& ' Select @Form_alert(2,"[2][|"+"M‚moire allou‚e: |][ Moins | "+Str$(B%)+" | Plus ]") ' Case 1 ' B%=Max(B%-B%\5,((A%*66)+(4*10000)+8000)) ' Case 2 ' Exit if True ' Case 3 ' B%=B%+B%\5 ' B%=Min(B%,X%) ' Endselect ' $S% ' Loop ' If A%>0 If @Form_alert(1,"[2][|"+"Confirmer? |][Confirmer| Annuler ]")=1 ' Gosub Defmouse(2) Ty&=0 Maxl&=0 Erase Page$() Erase Pag_adr%(),Pag_len&(),Pag_ind&() Clr Proc$ @Clr_eb Edited!(0)=False @Test_menu Dims&=A% Void Fre(0) Gosub Defmouse(0) ' @Page_manage(0) If Wopen!(0) Rdw_all(0) Endif ' Endif Endif ' Case 2 ' @W_rdexe A$=Nom_prg$ If (Not (Right$(A$,12)="SWEETEL2.PRG")) Or (Not @Exist(A$)) A$=@Fsel$("\SWEETEL2.PRG",A$,"Localiser Sweetel2?") Endif @W_rdexe If @Exist(A$) If Fre(0)>40000 ' Clr B$ Clr P%,N% Open "I",#1,A$ Gosub Defmouse(2) L%=Lof(#1) While L%>32022 B$=Input$(32022,#1) ' Note: conf pour mem_mini_gem=$20000 (131Kos) P%=Instr(B$,Mkl$(&H4878FFFF)+Mkl$(&H3F3C0048)+Mkl$(&H4E410480)+Mkl$(&H20000)+Mkl$(&H5C8F72FE)+Mki$(&H281)) If P%>0 Exit if True Else Sub L%,32000 Add N%,32000 Seek #1,N% ! repositionner Endif Wend If P%>0 Add P%,N% Dec P% Add P%,22 Seek #1,P% L%=Cvl(Input$(4,#1)) Else Clr P% Endif Close #1 Gosub Defmouse(0) ' If P%>0 T$=Str$(L%) T$=@Rinput$("M‚moire totale allou‚e … Sweetel2: (100000..+ß",T$) T$=@Epure$(T$) If Len(T$)>0 Clr E$ Div0%=False Resultat#=@Analyste(T$,E$) If Len(E$)=0 A%=Int(Resultat#) A%=Max(A%,250000) A%=Min(A%,&H10000000) ! 200 Mos ca suffit non?... ' X&=@Form_alert(1,"[2][|L'environnement va ˆtre recharg‚?|][Confirmer|OK, sauver| Annuler ]") If X&=3 If @Form_alert(1,"[2][|Patcher quand mˆme le programme?|][Confirmer| Annuler ]")=1 X&=-3 Endif Endif If X&<3 If X&=2 If Not @Env_save Clr X& Endif Endif ' ' If X&>0 If @Exist(A$) Gosub Defmouse(2) Open "U",#1,A$ Seek #1,P% Print #1,Mkl$(A%); ! ‚crire nouvelle valeur! Close #1 Gosub Defmouse(0) ' If X&=1 ! Go! For Boucl&=0 To Nbr_idxw& ~@Wind_delete(Boucl&) ! 10ø Next Boucl& ' Le m‚nage doit se faire sous couvert de wind_update .. Gosub Fmshow("Relance de "+Name$) Gosub Defmouse(2) ~@Wind_update01(1) Gosub Uninistr Gosub Defmouse(2) ~@Wind_update01(0) ~Fre(0) Gosub Defmouse(2) Gosub Defmouse(0) Gosub Fmhide ' Run A$ ! tout bˆtement!! ' Endif ' Endif Endif ' Endif Else Beep Endif Endif Else ~@Form_alert(1,"[3][|Impossible d'effectuer le patch!|Ce n'est pas Sweetel2.Prg!|][ Annuler ]") Gosub Comm.info("Gestion m‚moire","Patch impossible avec "+A$) Endif Else ~@Form_alert(1,@Errf$(8)) Gosub Comm.info("Gestion m‚moire","Pas assez de m‚moire") Endif Else ~@Form_alert(1,@Errf$(-33)) Gosub Comm.info("Gestion m‚moire","Fichier sweetel2.prg introuvable") Endif ' Endselect $S% ' Endif ' Return ' ' ' ' ..Proc g‚n‚rale de redraws, appelle en fait ' draw. [et Do_wredraw, si vous l'utilisez] ' Clip pas encore activ‚, mais Wind_update l'est. Procedure Redraw(Index&,X&,Y&,W&,H&) Local X2&,Y2&,W2&,H2& X2&=Clip_x& Y2&=Clip_y& W2&=Clip_w& H2&=Clip_h& Clip(X&,Y&,W&,H&) ! Clipping! If @Tstwork(Index&) ! Non smaller Draw(Index&,X&,Y&,W&,H&) Do_wredraw(Index&) Else ' Deffill 1,4,1 ' Pbox X&,Y&,X&+W&,Y&+H& ' Deffill 1,1,1 @Sm_draw(Index&,X&,Y&,W&,H&) Endif ' Clip_off Clip_x&=X2& Clip_y&=Y2& Clip_w&=W2& Clip_h&=H2& Reclip Return ' ' -------------------------------------------------- Procedure Gr.2.txt(Index&) Local A%,Y%,C%,D%,X%,Z%,E% Local A! ' Edited!(0)=True @Test_menu ' @Menu_set If @Wind_open(0)=>0 ~Evnt_timer(110) @Top(0) ~Evnt_timer(10) ~@Wind_update01(1) Gosub Defmouse(2) Void Fre(0) ' ~Fre() ' Rout1%=Varptr(Wherestart$) E%=Varptr(Vid$) Y%=C:Wherest%(L:E%) Z%=0 ' Y%=Min(Max(Y%+1,$ And And And And Imp ô$25) Clr T$ C%=0 D%=Y%-1 A!=False If Index&>2000 D%=23 Sub Index&,2000 Else if Index&>1000 D%=24 Sub Index&,1000 Else A!=True Endif If Index&=10 Index&=-1 Else Index&=0 Endif If Index& Swap C%,D% Endif If C%-D%=0 Inc D% Endif ' For A%=C% To D% Step Max(1,Sgn(D%-C%)) Z%=0 Clr T$ For X%=0 To 39 Vididx&=Asc(Mid$(Vid$,A%*40+X%+1,1))+32 If Instr(Quote$+Quof$,Chr$(Vididx&))<>0 T$=T$+Quof$+Chr$(Vididx&) Else T$=T$+Chr$(Vididx&) Endif Inc Z% Next X% ' If Not (Len(Trim$(T$))=0 And A!) A!=False T$="TXT "+Quote$+T$ ' X%=Len(T$) T$=Trim$(T$) Z%=Max(0,Z%-(X%-Len(T$))) If Z%=0 Insert Page$(Ty&)="FILL" Inc Ty& Inc Maxty& If Index& T$="CRH" Else T$="CR" Endif Else if Z%<40 If Index& T$=T$+Quof$+"|"+Quote$ Else T$=T$+Quof$+"*"+Quote$ Endif Else T$=T$+Quote$ If Index& Insert Page$(Ty&)=T$ Inc Ty& Inc Maxty& T$="REDO: 2" Insert Page$(Ty&)=T$ Inc Ty& Inc Maxty& T$="HAUT" Endif Endif Insert Page$(Ty&)=T$ Inc Ty& Inc Maxty& ' ' Else ! start ' A!=False Endif ' Next A% ' Gosub Defmouse(0) ~@Wind_update01(0) ' @Page_set Wsetsl(0) Do_wkill(0) Ty&=0 Do_winit(0,Ccsizex&,Ccsizey&+Ccsizey&*Ty&,Page$(Ty&)) Dwx_&(0)=0 Gosub Indentage ! rappel d'indentage Rdw_all(0) ~Evnt_timer(110) Else Gosub Menu.info("Erreur fenˆtre non accessible") Endif @Videkbd ' Return Procedure Dr.text(Key&) Local X%,B%,A&,Y% ! taille Local Mx&,My&,Mk& Local Vididx& Local T$ ! chaine ' Gosub W_rdexe ! ‚xecuter tous les redraws ‚ventuels ' @Caremouse ~@Wind_update01(1) Gosub Defmouse(7) ' Get_csize Contrl(0)=38 Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys B%=Ptsout(1) ' If Key&=148 Or Key&=153 ' @Lhidem Gosub Deffillcol(0) Gosub Pbox(W_ix&(2),W_iy&(2),W_iw&(2)+W_ix&(2),W_ih&(2)+W_iy&(2)) Gosub Deffillcol(Colg&) Gosub Defmouse(0) @Setxywh(2,X_desk&,Y_desk&,W_desk&,H_desk&) ~Evnt_timer(200) ' Gosub Deffillcol(0) Gosub Pbox(W_ix&(2),W_iy&(2),W_iw&(2)+W_ix&(2),W_ih&(2)+W_iy&(2)) Gosub Deffillcol(Colg&) Wind_clip(2) ! clipping fenˆtre ' Deftext ,&X0,,6 ~@Infow(2,Mki$(&H102)+" pour changer les tailles, Enter/Esc: confirmer") Deftext ,&X1,,Ttxt& Text @Wxacoord(2,Ttxt&),@Wyacoord(2,Ttxt&),"Taille texte "+Str$(Ttxt&) Do @Showm $S& Select @Geminp(Evnt_keybd()) ! D‚coder 2 octets->1 octet ' Case 200 ! plus @Hidem Ttxt&=Min(61,Ttxt&+1) Gosub Deffillcol(0) Gosub Pbox(W_ix&(2),W_iy&(2),W_iw&(2),W_ih&(2)) Gosub Deffillcol(Colg&) Deftext ,,,Ttxt& Text @Wxacoord(2,Ttxt&),@Wyacoord(2,Ttxt&),"Taille texte "+Str$(Ttxt&) @Videkbd ' Case 208 ! moins @Hidem Ttxt&=Max(9,Ttxt&-1) Gosub Deffillcol(0) Gosub Pbox(W_ix&(2),W_iy&(2),W_iw&(2),W_ih&(2)) Gosub Deffillcol(Colg&) Deftext ,,,Ttxt& Text @Wxacoord(2,Ttxt&),@Wyacoord(2,Ttxt&),"Taille texte "+Str$(Ttxt&) @Videkbd ' Case 27,13 Exit if True Endselect $S% Loop ' @Drawx(2) Clip_off ~@Wind_update01(0) Gosub Defmouse(0) ' Contrl(0)=12 ! Set character height, am Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=B% Vdisys ' Gosub Deftextattrb(&X0) @Showm @Get_csize Rdw_all(2) ' ' Else ' ' @Hidem Gosub Color(2) Gosub Box(@Wxacoord(2,2),@Wyacoord(2,2),@Wxacoord(2,322),@Wyacoord(2,152)) ~@Infow(2,"Selectionnez la position") @Caremouse Clr Mx&,My&,Mk& Graphmode (3) Clip W_ix&(2)+2,W_iy&(2)+2 To W_ix&(2)+322,W_iy&(2)+152 @Hidem While Mk&=0 ~Evnt_timer(20) ~@Graf_mkstate(Mx&,My&,Mk&,A&) Mx&=(Mx&\4)*4 My&=(My&\2)*2 Text Mx&,My&,Chr$(1) ~Evnt_timer(2) Text Mx&,My&,Chr$(1) Gosub Coord(Mx&,My&) ! afficher coord? Wend @Showm Clip_off Graphmode (1) ' Deftext ,&X1,,Ttxt& If Mk&=1 If Mx&=>W_ix&(2)-1 And Mx&<=W_ix&(2)+W_iw&(2)+1 If My&=>W_iy&(2)-1 And My&<=W_iy&(2)+W_ih&(2)+1 ' @Lhidem Gosub Box(@Wxacoord(2,2),@Wyacoord(2,2),@Wxacoord(2,322),@Wyacoord(2,152)) ~@Infow(2,"Tapez votre texte, BackSpace pour corriger, Enter: ok, Esc: quit") Clip(W_ix&(2)+2,W_iy&(2)+2,320,150) @Lshowm ' ' Select Mog& ' Case 0 ' Graphmode 1 ' Case 1 ' Graphmode 4 ' Case 2 ' Graphmode 3 ' Endselect ' Gosub Deftextcol(1) Do A&=@Geminp(Evnt_keybd()) ! D‚coder 2 octets->1 octet $S& Select A& ' Case 27,13 Exit if True ' Case 8 @Lhidem T$=Left$(T$,Max(0,Len(T$)-1)) Text Mx&,My&,T$+Chr$(32) @Lshowm ' Default If Len(T$)<80 @Lhidem T$=T$+Chr$(A&) Text Mx&,My&,T$ @Lshowm Endif ' Endselect $S% Loop Clip_off Graphmode (1) ' If Len(T$) And A&=$ And And And And Eqv Xor ' @Lhidem Contrl(0)=116 ! inquire text extend Contrl(1)=0 Contrl(3)=Len(T$) Contrl(6)=V~h For A&=1 To Len(T$) Intin(A&-1)=Asc(Mid$(T$,A&,1)) Next A& Vdisys X%=Ptsout(2) Y%=Ptsout(5) ' On calcule la partie … digitaliser ... Sub My&,Y% ' Gosub Gr.do @Digit(Mx&,My&,X%,Y%) @Lshowm ' Endif ' Endif ! tst my Endif ! tst mx Endif ! mk=1 ' Clr T$ Contrl(0)=12 ! Set character height, am Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=B% Vdisys ! appel ' @Lhidem Gosub Deftextattrb(&X0) @Lshowm @Get_csize @Drawx(2) Rdw_all(2) @Caremouse Gosub Deftextcol(Col1&) ' Endif Clr Mk&,Mx&,My&,A& ~@Wind_update01(0) Gosub Defmouse(0) ' Return Procedure Xmove(Key&) Local A%,T$ ' ~@Wind_update01(1) Gosub Defmouse(2) $S& Select Key& ' Case 244 ! ^droite For A%=1 To 20 Void Fre(0) ' Rout1%=Varptr(Rlsr$) E%=Varptr(Vid$) ~C:Rlsr%(L:E%) Next A% Edited!(1)=True ' Case 243 For A%=1 To 20 Void Fre(0) ' Rout1%=Varptr(Rlsl$) E%=Varptr(Vid$) ~C:Rlsl%(L:E%) Next A% Edited!(1)=True ' Case 150,21 ! ^ up Void Fre(0) For A%=1 To 12 T$=Left$(Vid$,40) Vid$=Right$(Vid$,960)+T$ Next A% Void Fre(0) Edited!(1)=True ' Case 4,160 ! ^down Void Fre(0) For A%=1 To 12 T$=Right$(Vid$,40) Vid$=T$+Left$(Vid$,960) Next A% Void Fre(0) Edited!(1)=True ' Endselect $S% Clr T$ ' Rdw_all(2) Gosub Defmouse(0) ~@Wind_update01(0) ' Return Procedure Rotate(X&) Local T$,E% ' If X&=0 X&=@Form_alert(3,"[2][|Flip? |][ HFlip | VFlip | Annuler ]") Endif ' ~@Wind_update01(1) Gosub Defmouse(2) ' $S& Select X& Case 2 ! V ' Edited!(1)=True Gosub Vflip ' ~C:Rout1%(L:Varptr(Vid$)) ' Void fre(0) ' Rdw_all(2) Case 1 ! H ' Edited!(1)=True Gosub Hflip ' ' Rdw_all(2) Endselect $S% ' Gosub Defmouse(0) ~@Wind_update01(0) Clr T$ ' Return ' ' digitalize: Mx/y/X/Y coords XYWH absolues Procedure Digit(Mx&,My&,X%,Y%) Local X2%,Y2%,Z%,A%,B% ' Mx&=Min($ And And And And Eqv *,Max(0,@Wxrcoord(2,Mx&)-2)) My&=Min(149,Max(0,@Wyrcoord(2,My&)-2)) X%=Max(4,Min(X%,319-Mx&)) Y%=Max(1,Min(Y%,149-My&)) Div Mx&,4 ! coords en pt minitel Div My&,2 ! idem mais pour les y Div X%,4 Div Y%,2 ' For Y2%=My& To My&+Y% For X2%=Mx& To Mx&+X% ' (2+milieu) ' A%=@Wxacoord(2,X2%*4)+2+2 B%=@Wyacoord(2,Y2%*2)+2+1 ' Clr Z% ' Z%=Point(A%,B%)<>0 ' Z%=Z%-(Point(A%+1,B%)<>0) ' Z%=Z%-(Point(A%+2,B%)<>0) ' Z%=Z%-(Point(A%+3,B%)<>0) ' Z%=Z%-(Point(A%,B%+1)<>0) ' Z%=Z%-(Point(A%+1,B%+1)<>0) ' Z%=Z%-(Point(A%+2,B%+1)<>0) ' Z%=Z%-(Point(A%+3,B%+1)<>0) ' ' If Point(@Wxacoord(2,X2%*4)+4,@Wyacoord(2,Y2%*2)+3)<>0 If Point(A%,B%)<>0 Dpoint(X2%,Y2%,Mog&,False) Endif ' Pbox @Wxacoord(2,X2%*4)+2,@Wyacoord(2,Y2%*2)+2,@Wxacoord(2,X2%*4)+2+4,@Wyacoord(2,Y2%*2)+2+2 Next X2% @Lhidem Gosub Pbox(@Wxacoord(2,Mx&*4)+2,@Wyacoord(2,Y2%*2)+2,@Wxacoord(2,(Mx&+X%)*4)+2+4,@Wyacoord(2,Y2%*2)+2+2) @Lshowm Next Y2% ' Return ' Procedure Dr.box(Key&) Local E% Local A& ' adr ' Gosub Wind_clip(2) ' @Caremouse ~@Wind_update01(1) Gosub Defmouse(7) ' Do @Caremouse Clr Mx&,My&,Mk& ~@Infow(2,"Clic g: coin superieur gauche / Clic d: annuler") While Mk&=0 ~Evnt_timer(20) ~Graf_mkstate(Mx&,My&,Mk&,A&) Gosub Coord(Mx&,My&) ! afficher coord? Wend ' If Mk&=1 If Mx&=>W_ix&(2)-1 And Mx&<=W_ix&(2)+W_iw&(2)+1 If My&=>W_iy&(2)-1 And My&<=W_iy&(2)+W_ih&(2)+1 ' Gosub Gr.do Edited!(1)=True Mx&=Max(Mx&,W_ix&(2)+2) My&=Max(My&,W_iy&(2)+2) ' ~@Infow(2,"D‚placer: coin inferieur droit / Clic d: annuler") ' ~Graf_rubberbox(Mx&,My&,16,12,Mx2&,My2&) ~Graf_rubberbox(Mx&,My&,2,4,Mx2&,My2&) ' Sub Mx&,W_ix&(2)+2 Sub My&,W_iy&(2)+2 Mx&=Min(319,Max(0,Mx&)) My&=Min(149,Max(0,My&)) ' Mx2&=Min(319,Mx2&+Mx&) My2&=Min(150,My2&+My&) ' Div Mx&,4 Div Mx2&,4 Div My&,2 Div My2&,2 If My&>My2& Swap My&,My2& Endif Mx2&=Min(Mx2&,79) My2&=Min(My2&,74) ' ' Void Fre(0) ' Rout1%=Varptr(Drawline$) If Key&=176 Or Key&=183 For A&=My& To My2& Void Fre(0) ' ~Fre() ' Rout1%=Varptr(Drawline$) E%=Varptr(Vid$) ~C:Drawline%(L:E%,W:Mx&,W:Mx2&,W:A&) Next A& ' Else Void Fre(0) ' ~Fre() ' Rout1%=Varptr(Drawline$) E%=Varptr(Vid$) ~C:Drawline%(L:E%,W:Mx&,W:Mx2&,W:My&) ~C:Drawline%(L:E%,W:Mx&,W:Mx2&,W:My2&) For A&=My& To My2& @Dpoint(Mx&,A&,Mog&,False) @Dpoint(Mx2&,A&,Mog&,False) Next A& Endif ' ' Line 2+W_ix&(2)+Mx&*4,2+W_iy&(2)+My&*2,2+W_ix&(2)+Mx2&*4,2+W_iy&(2)+My&*2 Rdw_all(2) @Caremouse ' Else Exit if True Endif ! tst my Else Exit if True Endif ! tst mx Else Exit if True Endif ! mk=1 Loop @Waitmouse ' Clr Mk&,Mx&,My&,A& ~@Wind_update01(0) Gosub Defmouse(0) ' Return Procedure Dr.ellips(Key&) Local Mx&,My&,Mk&,Index&,X%,Y%,X2%,Y2%,A& ' Gosub Wind_clip(2) ' @Caremouse ~@Wind_update01(1) Gosub Defmouse(7) ' Color 1 Do Index&=Btst(@Shift,2) Clr Mx&,My&,Mk& ~@Infow(2,"Clic g: centre / Clic d: annuler") While Mk&=0 ~Evnt_timer(20) ~@Graf_mkstate(Mx&,My&,Mk&,A&) Gosub Coord(Mx&,My&) ! afficher coord? Wend ' If Mk&=1 If Mx&=>W_ix&(2)-1 And Mx&<=W_ix&(2)+W_iw&(2)+1 If My&=>W_iy&(2)-1 And My&<=W_iy&(2)+W_ih&(2)+1 ' ~@Infow(2,"D‚placer: proportions / Clic d: annuler") Graphmode (3) While Mk&=1 ~@Graf_mkstate(Mx2&,My2&,Mk&,A&) Sub Mx2&,Mx& Sub My2&,My& ' Mx2&=Max(1,Abs(Mx2&)) Mx2&=Min(Mx2&,Mx&-W_ix&(2)-2) Mx2&=Min(Mx2&,W_ix&(2)+321-Mx&) ' My2&=Max(1,Abs(My2&)) My2&=Min(My2&,My&-W_iy&(2)-2) My2&=Min(My2&,W_iy&(2)+151-My&) If Index& My2&=Min(Mx2&,My2&) Mx2&=Min(Mx2&,My2&) My2&=My2&*(2/3) My2&=Min(My2&,My&-W_iy&(2)-2) My2&=Min(My2&,W_iy&(2)+151-My&) Endif ' @Lhidem Ellipse Mx&,My&,Mx2&,My2& Ellipse Mx&,My&,Mx2&,My2& @Lshowm Graphmode (1) Gosub Coord(Mx2&,My2&) ! afficher coord? Graphmode (3) Wend Graphmode (1) Sub Mx&,W_ix&(2)+2 Sub My&,W_iy&(2)+2 ' If Mk&=0 ' Gosub Gr.do Edited!(1)=True Mx&=Min(319,Max(0,Mx&)) My&=Min(149,Max(0,My&)) Div Mx&,4 Div Mx2&,4 Div My&,2 Div My2&,2 Mx2&=Max(Mx2&,1) My2&=Max(My2&,1) ' If Upper$(Chr$(Key&))="C" For Resultat#=0 To 2*Pi Step Min(Pi/(Pi*My2&),Pi/(Pi*Mx2&)) @Dpoint(Mx&+Cos(Resultat#)*Mx2&,My&+Sin(Resultat#)*My2&,Mog&,True) Next Resultat# Else ' ' Rout1%=Varptr(Drawline$) Void Fre(0) For Resultat#=Pi/2 To $ And And And And Eqv And *Pi+Pi/2 Step (Min(Pi/(Pi*My2&),Pi/(Pi*Mx2&))) ' X%=Mx&+Cos(Resultat#)*Mx2& Y%=My&+Sin(Resultat#)*My2& X2%=Mx& Y2%=Y% ! {inutile} X%=Min(Max(0,X%),79) X2%=Min(Max(0,X2%),79) Y%=Min(Max(0,Y%),74) Y2%=Min(Max(0,Y2%),74) ' If X%>X2% ! neg Swap X%,X2% Else if X%=X2% ! 0 Inc X2% Endif ' Void Fre(0) ' ~Fre() ' Rout1%=Varptr(Drawline$) E%=Varptr(Vid$) ~C:Drawline%(L:E%,W:X%,W:X2%,W:Y%) Next Resultat# Endif ' If Not (Upper$(Chr$(Key&))="C") Rdw_all(2) Endif Endif ' Else Exit if True Endif Else Exit if True Endif Else Exit if True Endif ' Loop @Waitmouse ' Clr Mk&,Mx&,My&,A%,B%,X%,Y% ~@Wind_update01(0) Gosub Defmouse(0) Return Procedure Dr.line(Key&) Local Mx&,My&,Mk&,A& ' Gosub Wind_clip(2) ' @Caremouse ~@Wind_update01(1) Gosub Defmouse(7) ' Do Clr Mx&,My&,Mk& ~@Infow(2,"Clic g: 1er point / Clic d: annuler") While Mk&=0 ~Evnt_timer(20) ~@Graf_mkstate(Mx&,My&,Mk&,A&) Gosub Coord(Mx&,My&) ! afficher coord? Wend ' If Mk&=1 If Mx&=>W_ix&(2)-1 And Mx&<=W_ix&(2)+W_iw&(2)+1 If My&=>W_iy&(2)-1 And My&<=W_iy&(2)+W_ih&(2)+1 ' ~@Infow(2,"D‚placer: 2e point / Clic d: annuler") Graphmode (3) While Mk&=1 ~@Graf_mkstate(Mx2&,My2&,Mk&,A&) @Lhidem Gosub Line(Mx&,My&,Mx2&,My2&) Graphmode (1) @Lshowm Gosub Coord(Mx2&,My2&) ! afficher coord? Graphmode (3) @Lhidem Gosub Line(Mx&,My&,Mx2&,My2&) @Lshowm Wend Graphmode (1) ' If Mk&=0 ' Gosub Gr.do Edited!(1)=True Mx&=Min(Max(0,Mx&-W_ix&(2)-2),319) Mx2&=Min(Max(0,Mx2&-W_ix&(2)-2),319) My&=Min(Max(0,My&-W_iy&(2)-2),149) My2&=Min(Max(0,My2&-W_iy&(2)-2),149) ' Gosub Do_line(Mx&,My&,Mx2&,My2&,Mog&) ' ' Rdw_all(2) Endif ' Else Exit if True Endif Else Exit if True Endif Else Exit if True Endif ' Loop @Waitmouse ' Clr Mk&,Mx&,My&,A% ~@Wind_update01(0) Gosub Defmouse(0) Return Procedure Do_line(Mx&,My&,Mx2&,My2&,Mog&) Local A%,B%,X#,Y# ' Gosub Wind_clip(2) ' Div Mx&,4 Div Mx2&,4 Div My&,2 Div My2&,2 Edited!(1)=True ' X#=Mx2&-Mx& Y#=My2&-My& B%=Sqr(X#^2+Y#^2) If B%=0 @Dpoint(Mx&,My&,Mog&,True) Else For A%=0 To B% @Dpoint(Mx&+(A%*(X#/B%)),My&+(A%*(Y#/B%)),Mog&,True) Next A% Endif ' Return ' Procedure Dr.brush Local Mk&,X2&,Y2&,A&,B&,C&,Key&,A& Local Mx&,My& ' Gosub Wind_clip(2) ' ~@Wind_update01(1) ~@Infow(2,"Clic g: brush / Clic d: annuler") Clr Mk& While Mk&=0 ~Evnt_timer(20) ~@Graf_mkstate(X2&,Y2&,Mk&,A&) Gosub Coord(X2&,Y2&) ! afficher coord? Wend Gosub Gr.do X2&=@Wxacoord(2,0) Y2&=@Wyacoord(2,0) Gosub Defmouse(3) ~Graf_mkstate(Mx&,My&,B&,A&) If B&<>0 Mk&=B& Endif Do If Mk&=1 ! saloperie de gem $S& Select @Xmousek Case 0 Default Mk&=@Xmousek ! le 'vrai' clic est ici Endselect $S% Else if Mk&=0 Mk&=@Xmousek ! le 'vrai' clic est ici Endif ' If @Wavisible(2,Mx&,My&) ! Coord visible? ' Edited!(1)=True Gosub Coord(Mx&,My&) ! afficher coord? Mx&=@Wxrcoord(2,Mx&) ! Coord My&=@Wyrcoord(2,My&) ! relatives! ' Mx&=Mx&+(Int(Rand(9)-4)*4) My&=My&+(Int(Rand(9)-4)*2) If Mx&=>1 And My&=>1 And Mx&<=321 And My&<=151 ' Mx&=(Mx&-2)\4 My&=(My&-2)\2 ' B&=Mx&\2 ! pos x C&=My&\3 ! et pos y ' Vididx&=C&*40+B&+1 A&=Asc(Mid$(Vid$,Vididx&,1)) ' B&=Mod(Mx&,2) ! 0,1 C&=Mod(My&,3) ! 0,1,2 ' If Mk&=2 A&=Bclr(A&,(B&+C&*2)) Else if Mk&=3 A&=Bset(A&,(B&+C&*2)) Else if Mk&=1 $S& Select Mog& Case 0 ! clic gauche A&=Bset(A&,(B&+C&*2)) Case 1 A&=Bclr(A&,(B&+C&*2)) Case 2 A&=Bchg(A&,(B&+C&*2)) Endselect $S% Endif ' Mid$(Vid$,Vididx&,1)=Chr$(A&) @Lhidem @Putp(X2&+(Mx&\2)*8+2,Y2&+(My&\3)*6+2,A&) @Lshowm ' Endif ' Endif ' ~@Graf_mkstate(Mx&,My&,Mk&,A&) Loop until Mk&=>2 Or Mk&=0 ~@Infow(2,"") @Caremouse Gosub Defmouse(0) ~@Wind_update01(0) ' Return ' Procedure Spl_init Nombre_max&=32 Pas_max&=32 Dim A#(Nombre_max&),B#(Nombre_max&),C#(Nombre_max&),D#(Nombre_max&) Dim X_appui#(Nombre_max&),Y_appui#(Nombre_max&) Dim X_spline#(Nombre_max&*Pas_max&),Y_spline#(Nombre_max&*Pas_max&) Return Procedure Spl_uninit Clr Nombre_max& Clr Pas_max& Erase A#(),B#(),C#(),D#() Erase X_appui#(),Y_appui#() Erase X_spline#(),Y_spline#() Return Procedure Dr.spline Local Nombre_max&,Pas_max& Local X2%,Y2%,I&,A%,A& ' Void Fre(0) If Fre()>20000 Gosub Defmouse(3) ~@Wind_update01(1) Gosub Spl_init ! 20 Ko n‚cessaires Do X2%=@Wxacoord(2,0) Y2%=@Wyacoord(2,0) ' Nombre&=-1 ~@Infow(2,"Clic gauche: 1er point - clic droit: annuler") Repeat ~@Graf_mkstate(Mx&,My&,Mk&,A&) Gosub Coord(Mx&,My&) ! afficher coord? ' If Mk&=1 If @Wavisible(2,Mx&,My&) ! Coord visible? ' Edited!(1)=True Mx&=@Wxrcoord(2,Mx&) ! Coord My&=@Wyrcoord(2,My&) ! relatives! ' If Mx&=>1 And My&=>1 And Mx&<=321 And My&<=151 ' ~@Infow(2,"Clic gauche: "+Str$(Nombre&+3)+"e point - clic droit: tracer") ' Mx&=(Mx&-2)\4 My&=(My&-2)\2 ' Gosub Pbox(X2%+Mx&*4,Y2%+My&*2,X2%+Mx&*4+2,Y2%+My&*2+2) Inc Nombre& X_appui#(Nombre&)=Mx& Y_appui#(Nombre&)=My& Repeat Until @Xmousek=0 Endif Endif Endif ' Until Nombre&=>Nombre_max&-1 Or Mk&=2 ' If Nombre&=>2 ' Reponse&=@Form_alert(1,"[2][|"+"Relier premier |et dernier point ?][ Oui | Non ]") ' If Reponse&=1 ! Si courbe ferm‚e ' Relier!=True ! fixer flag, ' Inc Nombre& ! augmenter nombre de points d'appui ' X_pui#(Nombre&)=X_appui#) ! et occuper coordonn‚es du ' Y_appui#(Nombre&)=Y_appui#(0) ! dernier point. ' Else Relier!=False ' Endif Pas&=10 ! Au moins 1, pas_max& au maximum ' Gosub Defmouse(2) Lisser_splines(Nombre&,Pas&,Relier!,X_appui#(),Y_appui#(),X_spline#(),Y_spline#()) ' ' Mission accomplie, maintenant sortir sur ‚cran. Nombre_spl&=Nombre&*Pas& ' For I&=1 To Nombre_spl& Do_line(X_spline#(Pred(I&))*4,Y_spline#(Pred(I&))*2,X_spline#(I&)*4,Y_spline#(I&)*2,Mog&) Next I& Gosub Defmouse(3) Endif ' Loop until Nombre&<2 Rdw_all(2) ~@Infow(2,"") Gosub Spl_uninit ~@Wind_update01(0) Gosub Defmouse(0) ' Else ! pas assez de m‚moire! ~@Form_alert(1,@Errf$(8)) ' Endif ' Return Procedure Lisser_splines(N&,M&,Relie!,Var X_appui#(),Y_appui#(),X_spline#(),Y_spline#()) Local I&,J&,K& ' If Relie! !\ Sx#=(X_appui#(1)-X_appui#(N&-1))*0.5 ! \ Sy#=(Y_appui#(1)-Y_appui#(N&-1))*0.5 ! \ D‚riv‚es identiques Else ! > pour les points Sx#=0 ! / 0 et n Sy#=0 ! / Endif !/ ' Cubique_splines(N&,Sx#,Sx#,X_appui#(),B#(),C#(),D#()) ' H#=1/M& K&=0 For I&=1 To N& T#=-1 For J&=0 To M&-1 X_spline#(K&)=((D#(I&)*T#+C#(I&))*T#+B#(I&))*T#+X_appui#(I&) Add T#,H# Inc K& Next J& Next I& X_spline#(K&)=X_appui#(N&) ' Cubique_splines(N&,Sy#,Sy#,Y_appui#(),B#(),C#(),D#()) ' K&=0 For I&=1 To N& T#=-1 For J&=0 To M&-1 Y_spline#(K&)=((D#(I&)*T#+C#(I&))*T#+B#(I&))*T#+Y_appui#(I&) Add T#,H# Inc K& Next J& Next I& Y_spline#(K&)=Y_appui#(N&) ' Return Procedure Cubique_splines(N&,S0#,Sn#,Var A#(),B#(),C#(),D#()) Local N1&,I&,R#,Dr#,S# N1&=N&-1 ' B#(0)=(A#(1)-A#(0)-S0#)*6 For I&=1 To N1& B#(I&)=(A#(Succ(I&))-A#(I&)*2+A#(Pred(I&)))*3 Next I& B#(N&)=(A#(N1&)-A#(N&)+Sn#)*6 ' C#(0)=B#(0)*0.5 B#(1)=B#(1)-B#(0)*0.25 R#=1.75 Dr#=1/R# C#(1)=B#(1)/1.75 For I&=2 To N1& S#=-0.5*Dr# Add B#(I&),B#(Pred(I&))*S# R#=S#*0.5+2 Dr#=1/R# C#(I&)=B#(I&)*Dr# Next I& ' S#=-Dr# B#(N&)=B#(N&)+B#(N1&)*S# R#=S#*0.5+2 C#(N&)=B#(N&)/R# For I&=N1& To 1 Step -1 If B#(I&)=0 Temp#=1.0E-09 Else Temp#=B#(I&) Endif Mul C#(I&),1-C#(Succ(I&))/Temp#*0.5 Next I& ' If B#(0)=0 Temp#=1.0E-09 Else Temp#=B#(0) Endif ' C#(0)=C#(0)*($ And And And And Imp ls% Þ$ Xor 1)/Temp#) For I&=1 To N& I_pred&=Pred(I&) B#(I&)=A#(I&)-A#(I_pred&)+(C#(I&)*2+C#(I_pred&))/6 D#(I&)=(C#(I&)-C#(I_pred&))/6 Next I& ' For I&=1 To N& Mul C#(I&),0.5 Next I& Return ' ' ' ' ' ' ' ' ' ' Flag: 0 normal / -1 EMUL Procedure Select_text(Flag!) Local X%,Y%,Boucl&,X2%,Y2%,C%,A%,N%,T%,D%,Z%,E%,F% Local A!,B! Local T$ ' ' "Deftail(Font_tail&) Clip(Rx&(5)+Ob_x(Adr%(5),Rsc_box&),Ob_y(Adr%(5),Rsc_box&)+Ry&(5),Ob_w(Adr%(5),Rsc_box&),Ob_h(Adr%(5),Rsc_box&)) @Hidem If Not Flag! Get_csize Endif Contrl(0)=38 ! Inquire Current Graphic Text Attributes Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys X%=Ptsout(1) Z%=X% ! sauvegarde Boucl&=X% D%=Colg& E%=Col1& F%=Font& If Flag! Emul_text(0) Font&=Efont& ' Contrl(0)=38 ! Inquire Current Graphic Text Attributes Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys X%=Ptsout(1) ' Endif Clr X2%,Y2% C%=2 If Flag! ' Emul_text(0) Ob_state(Adr%(5),Rsc_stu1&)=Bset(Ob_state(Adr%(5),Rsc_stu1&),3) Ob_state(Adr%(5),Rsc_std1&)=Bset(Ob_state(Adr%(5),Rsc_std1&),3) Ob_state(Adr%(5),Rsc_stu2&)=Bset(Ob_state(Adr%(5),Rsc_stu2&),3) Ob_state(Adr%(5),Rsc_std2&)=Bset(Ob_state(Adr%(5),Rsc_std2&),3) Ob_flags(Adr%(5),Rsc_stu1&)=Bclr(Ob_flags(Adr%(5),Rsc_stu1&),2) Ob_flags(Adr%(5),Rsc_std1&)=Bclr(Ob_flags(Adr%(5),Rsc_std1&),2) Ob_flags(Adr%(5),Rsc_stu2&)=Bclr(Ob_flags(Adr%(5),Rsc_stu2&),2) Ob_flags(Adr%(5),Rsc_std2&)=Bclr(Ob_flags(Adr%(5),Rsc_std2&),2) Ob_flags(Adr%(5),Rsc_stu1&)=Bclr(Ob_flags(Adr%(5),Rsc_stu1&),6) Ob_flags(Adr%(5),Rsc_std1&)=Bclr(Ob_flags(Adr%(5),Rsc_std1&),6) Ob_flags(Adr%(5),Rsc_stu2&)=Bclr(Ob_flags(Adr%(5),Rsc_stu2&),6) Ob_flags(Adr%(5),Rsc_std2&)=Bclr(Ob_flags(Adr%(5),Rsc_std2&),6) Else Ob_state(Adr%(5),Rsc_stu1&)=Bclr(Ob_state(Adr%(5),Rsc_stu1&),3) Ob_state(Adr%(5),Rsc_std1&)=Bclr(Ob_state(Adr%(5),Rsc_std1&),3) Ob_state(Adr%(5),Rsc_stu2&)=Bclr(Ob_state(Adr%(5),Rsc_stu2&),3) Ob_state(Adr%(5),Rsc_std2&)=Bclr(Ob_state(Adr%(5),Rsc_std2&),3) Ob_flags(Adr%(5),Rsc_stu1&)=Bset(Ob_flags(Adr%(5),Rsc_stu1&),2) Ob_flags(Adr%(5),Rsc_std1&)=Bset(Ob_flags(Adr%(5),Rsc_std1&),2) Ob_flags(Adr%(5),Rsc_stu2&)=Bset(Ob_flags(Adr%(5),Rsc_stu2&),2) Ob_flags(Adr%(5),Rsc_std2&)=Bset(Ob_flags(Adr%(5),Rsc_std2&),2) Ob_flags(Adr%(5),Rsc_stu1&)=Bset(Ob_flags(Adr%(5),Rsc_stu1&),6) Ob_flags(Adr%(5),Rsc_std1&)=Bset(Ob_flags(Adr%(5),Rsc_std1&),6) Ob_flags(Adr%(5),Rsc_stu2&)=Bset(Ob_flags(Adr%(5),Rsc_stu2&),6) Ob_flags(Adr%(5),Rsc_std2&)=Bset(Ob_flags(Adr%(5),Rsc_std2&),6) Endif Char{{Ob_spec(Adr%(5),Rsc_stx&)}}=Str$(X%,3) ' ~Objc_draw(Adr%(5),0,255,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) ~@Form_exdo(5,-2) Gosub Deftextcol(Col1&) Deftext Col1& Gosub Deffillcol(Colg&) Gosub Pbox(Ob_x(Adr%(5),0)+Ob_x(Adr%(5),Rsc_box&)+16,Ob_y(Adr%(5),0)+Ob_y(Adr%(5),Rsc_box&)+16,Ob_x(Adr%(5),0)+Ob_x(Adr%(5),Rsc_box&)+Ob_w(Adr%(5),Rsc_box&)-16,Ob_y(Adr%(5),0)+Ob_y(Adr%(5),Rsc_box&)+Ob_h(Adr%(5),Rsc_box&)-16) ' Text Ob_x(Adr%(5),0)+Ob_x(Adr%(5),Rsc_box&)+X%,Ob_y(Adr%(5),0)+Ob_y(Adr%(5),Rsc_box&)+Ob_h(Adr%(5),Rsc_box&)-Z%-16,"ABcd" Text Ob_x(Adr%(5),0)+Ob_x(Adr%(5),Rsc_box&),Ob_y(Adr%(5),0)+Ob_y(Adr%(5),Rsc_box&)+Ob_h(Adr%(5),Rsc_box&)-Z%-16,"ABcd" @Showm Do Y%=X% ! ancien x ~@Wind_update01(1) N%=@Form_exdo(5,999) ~@Wind_update01(0) ~Objc_change(Adr%(5),Byte(N%),0,Rx&(5),Ry&(5),Rw&(5),Rh&(5),Bclr(Ob_state(Adr%(5),Byte(N%)),0),1) ' $S& Select Byte(N%) Case Rsc_stok& Exit if True ' Case 1 ! 0 N%=-1 Exit if True ' Case Rsc_stup&,Rsc_stdw&,Rsc_fup&,Rsc_fdw& ! Text ' ' If Btst(N%,15) ! Changer de fonte! Select Byte(N%) ' Case Rsc_fup&,Rsc_fdw& Boucl&=True ! modif If Byte(N%)=Rsc_fup& Set_font(Font&+1) Else Set_font(Font&-1) Endif ' Default If Byte(N%)=Rsc_stup& X%=Min(255,X%+1) Else X%=Max(2,X%-1) Endif Endselect ' If X%>Y% A%=1 Else A%=-1 Endif Get_csize X2%=Ccsizex& Y2%=Ccsizey& Do Contrl(0)=12 Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=X% Vdisys If @Testex Get_csize If Ccsizex&=X2% And Ccsizey&=Y2% ! ca ne sert … rien! If A%=1 X%=Y% Endif Endif Exit if True Else if X%>199 Or X%<4 ! Erreur d‚passement des limites X%=Y% Exit if True Else If X% Add X%,A% Endif Endif Loop @Hidem Get_csize Get_cdec ~Objc_draw(Adr%(5),Rsc_box&,255,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) Gosub Deftextcol(Col1&) Gosub Deffillcol(Colg&) Gosub Pbox(Ob_x(Adr%(5),0)+Ob_x(Adr%(5),Rsc_box&)+16,Ob_y(Adr%(5),0)+Ob_y(Adr%(5),Rsc_box&)+16,Ob_x(Adr%(5),0)+Ob_x(Adr%(5),Rsc_box&)+Ob_w(Adr%(5),Rsc_box&)-16,Ob_y(Adr%(5),0)+Ob_y(Adr%(5),Rsc_box&)+Ob_h(Adr%(5),Rsc_box&)-16) Text Ob_x(Adr%(5),0)+Ob_x(Adr%(5),Rsc_box&),Ob_y(Adr%(5),0)+Ob_y(Adr%(5),Rsc_box&)+Ob_h(Adr%(5),Rsc_box&)-Z%-16,"ABcd" Char{{Ob_spec(Adr%(5),Rsc_stx&)}}=Str$(X%,3) ~Objc_draw(Adr%(5),Rsc_stx&,255,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) @Showm ' Case Rsc_stu1&,Rsc_std1&,Rsc_stu2&,Rsc_std2& ! couleur If Btst(N%,15) ! Pannel If Byte(N%)=Rsc_std1& Or Byte(N%)=Rsc_stu1& ' ~form_dial(3,0,0,0,0,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) ~@Form_exdo(5,-3) Col1&=@Pannel(Col1&) ~Objc_draw(Adr%(5),0,255,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) Else if Byte(N%)=Rsc_stu2& Or Byte(N%)=Rsc_std2& ' ~form_dial(3,0,0,0,0,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) ~@Form_exdo(5,-3) Colg&=@Pannel(Col1&) ~Objc_draw(Adr%(5),0,255,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) Endif Else If Byte(N%)=Rsc_std1& Dec Col1& Else if Byte(N%)=Rsc_stu1& Inc Col1& Else if Byte(N%)=Rsc_stu2& Inc Colg& Else if Byte(N%)=Rsc_std2& Dec Colg& Endif Endif Select Work_out(13) Case 1 To Col1&=Max(1,Min(Col1&,Work_out(13)-1)) Colg&=Max(1,Min(Colg&,Work_out(13)-1)) Default Col1&=Max(1,Min(Col1&,&H7FFF)) Colg&=Max(1,Min(Colg&,&H7FFF)) Endselect @Hidem ~Objc_draw(Adr%(5),Rsc_box&,255,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) Gosub Deftextcol(Col1&) Gosub Deffillcol(Colg&) Gosub Pbox(Ob_x(Adr%(5),0)+Ob_x(Adr%(5),Rsc_box&)+16,Ob_y(Adr%(5),0)+Ob_y(Adr%(5),Rsc_box&)+16,Ob_x(Adr%(5),0)+Ob_x(Adr%(5),Rsc_box&)+Ob_w(Adr%(5),Rsc_box&)-16,Ob_y(Adr%(5),0)+Ob_y(Adr%(5),Rsc_box&)+Ob_h(Adr%(5),Rsc_box&)-16) Text Ob_x(Adr%(5),0)+Ob_x(Adr%(5),Rsc_box&),Ob_y(Adr%(5),0)+Ob_y(Adr%(5),Rsc_box&)+Ob_h(Adr%(5),Rsc_box&)-Z%-16,"ABcd" Char{{Ob_spec(Adr%(5),Rsc_stx&)}}=Str$(X%,3) ~Objc_draw(Adr%(5),Rsc_stx&,255,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) @Showm ' Endselect $S% Loop ' ~form_dial(3,0,0,0,0,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) ~@Form_exdo(5,-3) If N%=>0 If Not Flag! ' If Flag! ' If Wopen!(4) ' A!=True ' ~@Wind_close(4) ' Else ' A!=False ' Endif ' Endif Gosub Set_font(Font&) B!=False If D%<>Colg& Or E%<>Col1& @Hidem Gosub Deftextcol(Col1&) Gosub Deffillcol(Colg&) Gosub Color(Colg&) Gosub Defmouse(2) Gosub Reloadfnt Gosub Defmouse(0) @Showm Endif If Boucl&<>X% Font_tail&=X% @Hidem Contrl(0)=12 Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=X% Vdisys Get_csize Get_cdec ' ' Gosub Wind_keep(T$) Gosub Defmouse(2) Gosub Field_max @Page_set ' ~@Winds_fields ' Gosub Wind_rest(T$) B!=True For A%=Nbr_idxw& Downto 0 If Wopen!(A%) @Wsetsl(&H0) @Rdw_all(A%) Endif Next A% @Showm ' Gosub Clear_cache ! vider cache video-TEXT If Flag! Gosub Emul_uninit Ncach&=65536/(@Bitlen(Ccsizex&,Ccsizey&)+15) Ncach&=Max(16,Ncach&) Ncach&=Min(4096,Ncach&) Gosub Emul_init Endif Gosub Defmouse(0) Endif ' If Flag! ' If A! ' ~@Wind_open(4) ' ' @Rdw_all(4) ' Endif ' Endif If D%<>Colg& Or E%<>Col1& If Not B! For X%=Nbr_idxw& Downto 0 If Wopen!(X%) @Rdw_all(X%) Endif Next X% Endif @Showm Endif Else @Hidem Efont&=Font& Vdt_tail&=X% ' Contrl(0)=12 Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=X% Vdisys ' Contrl(0)=38 ! Inquire Current Graphic Text Attributes Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys Eccsizey&=Ptsout(3) ' Contrl(0)=117 ! Inquire Character Cell Width Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Vdisys Eccsizex&=Ptsout(0) ' @Hidem Gosub Emul_uninit Gosub Emul_init ' If Flag! Set_font(F%) Endif Contrl(0)=12 Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=Z% Vdisys Get_csize Get_cdec Endif Else Font&=F% If Flag! Gosub Sweety_text Endif Contrl(0)=12 Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=Z% Vdisys Get_csize Get_cdec Endif Set_text&=0 ! restore! If Flag! Gosub Emul_text(0) Else Gosub Sweety_text Endif ' Return ' ' Procedure Deftail(T&) ! ptsout1 ' If Set_tail&<>T& ' Contrl(0)=12 ' Contrl(1)=1 ' Contrl(3)=0 ' Contrl(6)=V~h ' Ptsin(0)=0 ' Ptsin(1)=T& ' Vdisys ' Set_tail&=T& ' Endif Return ' Procedure Set_font(N&) N&=Max(1,Min(Maxfont&,N&)) Font&=N& ' Contrl(0)=21 ! set text face Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=Font&(Font&) Vdisys ' Contrl(0)=12 ! Set character height, am Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=Font_tail& Vdisys ' Get_csize Get_cdec Return Procedure Get_cdec Contrl(0)=38 Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys Font_dec&=Ptsout(1) ! d‚calage Return ' Procedure Gdos Local A& Local E$ ' If Dim?(Font&())=0 Dim Font&(99) Font&(1)=Vqt_name(1,E$) ! fonte ROM If Gdos? Arrayfill Font&(),Font&(1) ! Remplir avec Maxfont&=Min(99,Vst_load_fonts(0))+1 For A&=1 To Maxfont& Font&(A&)=Vqt_name(A&,E$) Next A& ' Font&=1 ! 6*6 font ' Set_font(Font&) ' Get_csize Endif Endif Return ' Procedure Ungdos ~Vst_unload_fonts(0) Erase Font&() Return ' ' ' ' ' ' ' ' ' ' ' ' ' ' arranger fenˆtres (user) Procedure Arrange_w Local N%,X%,A%,D%,W%,H% ' Exdo!=True X%=Byte(@Form_exdo(15,0)) ~@Wind_update01(0) Ob_state(Adr%(15),X%)=Bclr(Ob_state(Adr%(15),X%),0) ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(15),Ry&(15),Rw&(15),Rh&(15)) ~@Form_exdo(15,-3) Sub X%,Rng_1& Inc X% If X%<=0 Or X%>4 X%=0 Endif ' If X%>0 Clr N% For A%=0 To Nbr_idxw&-1-1 If @Tstwork(A%) Inc N% Endif Next A% ' If N%>0 Clr D% If X%=3 N%=4 Endif W%=W_desk&\N% H%=H_desk&\N% For A%=0 To Nbr_idxw&-1-1 If @Tstwork(A%) $S& Select X% Case 1 @Setxywh(A%,X_desk&,Y_desk&+D%*H%,W_desk&,H%-4) ' Case 2 @Setxywh(A%,X_desk&+D%*W%,Y_desk&,W%-2,H_desk&) ' Case 3 @Setxywh(A%,Abs(Even(A%))*W%*2+X_desk&,Abs(A%>1)*H%*2+Y_desk&,W%*2-2,H%*2-1) ' Case 4 @Setxywh(A%,X_desk&+D%*8,Y_desk&+D%*8,W_desk&-N%*8,H_desk&-N%*8) ' Endselect $S% Inc D% Endif Next A% ' Endif ' Endif ' Return ' Procedure Fill(Key&) Local Mx&,My&,Mk&,X&,Y&,Z&,A&,W&,H& Local A$,B$ ! filler Local B&,C&,D&,E& Local A& ' Gr.do Y&=Mog& Mog&=2 ' @Caremouse ~@Wind_update01(1) Gosub Defmouse(7) ' Do Clr Mx&,My&,Mk& ~@Infow(2,"Clic g: remplir / Clic d: annuler") While Mk&=0 ~Evnt_timer(20) ~@Graf_mkstate(Mx&,My&,Mk&,A&) Gosub Coord(Mx&,My&) ! afficher coord? Wend ' If Mk&=1 If Mx&=>W_ix&(2)-1 And Mx&<=W_ix&(2)+W_iw&(2)+1 If My&=>W_iy&(2)-1 And My&<=W_iy&(2)+W_ih&(2)+1 ' ' samplefill en 3 ‚tapes (c)Sts ' pour formes pas trop tordues .. ' @Lhidem Gosub Defmouse(0) ~@Infow(2,"Calculs en cours..") ' Mx&=Min(Max(0,Mx&-W_ix&(2)-2),319) My&=Min(Max(0,My&-W_iy&(2)-2),149) Div Mx&,4 Div My&,2 Edited!(1)=True ' ' un point.. + ' Z&=@Xptst(Mx&,My&) ! blanc ou noir?? ' ' tracer une ligne de remplissage /------+--------\ X&=Mx& While (@Xptst(X&,My&)=Z&) And X&<=79 @Dpoint(X&,My&,Mog&,True) Inc X& Wend H&=X&-1 X&=Mx&-1 While (@Xptst(X&,My&)=Z&) And X&=>0 @Dpoint(X&,My&,Mog&,True) Dec X& Wend W&=X&+1 ' W et H: ligne de tracage ' If H&-W&=>0 ! w ||||||||||||||| h ' tracage des lignes verticales /------+--------\ ' ||||||||||||||| For A&=W& To H& ' X&=My&-1 ! vers le haut While (@Xptst(A&,X&)=Z&) And X&=>0 @Dpoint(A&,X&,Mog&,True) Dec X& Wend ' b | || c ' Noter les extremes ^||||||||||^ ' /------------\ ' .||||||||||. ' d | ||| | e If A&=W& B&=X&+1 Else if A&=H& C&=X&+1 Endif ' X&=My&+1 ! vers le bas While (@Xptst(A&,X&)=Z&) And X&<=74 @Dpoint(A&,X&,Mog&,True) Inc X& Wend ' ' Noter, idem plus haut (v. plus haut) If A&=W& D&=X&-1 Else if A&=H& E&=X&-1 Endif ' Next A& ' If True<>False ! ne pas executer ' ' troisiŠme phase: remplir les cot‚s ' bord gauche: W For A&=B& To D& X&=W&-1 If X&>0 While (@Xptst(X&,A&)=Z&) And X&>0 @Dpoint(X&,A&,Mog&,True) Dec X& Wend Endif Next A& ' For A&=C& To E& X&=H&+1 If X&<79 While (@Xptst(X&,A&)=Z&) And X&>0 @Dpoint(X&,A&,Mog&,True) Inc X& Wend Endif Next A& ' Endif ! /////////\\\\\\\\ ' Endif ' @Lshowm ' Rdw_all(2) @Caremouse ' Else Exit if True Endif Else Exit if True Endif Else Exit if True Endif Gosub Defmouse(7) ' Loop ' Mog&=Y& ~@Wind_update01(0) Gosub Defmouse(0) Return ' Procedure H.id Local Mx&,My&,Mk&,X% Local A& ' ~@Wind_update01(0) X%=@Form_alert(1,"[2][|"+"D‚truire ou ins‚rer une ligne? |][ Delete | Insert | Annuler ]") ' If X%<>3 @Caremouse ~@Wind_update01(1) Gosub Defmouse(7) ' Clr Mx&,My&,Mk& ~@Infow(2,"Clic g: position / Clic d: annuler") Graphmode (3) While Mk&=0 ~@Graf_mkstate(Mx&,My&,Mk&,A&) Graphmode (1) Gosub Coord(0,My&) ! afficher coord? Graphmode (3) Mx&=Min(39,Max(0,(@Wxrcoord(2,Mx&)-2)\8)) My&=Min(24,Max(0,(@Wyrcoord(2,My&)-2)\6)) ' @Lhidem Gosub Pbox(@Wxacoord(2,2),@Wyacoord(2,My&*6+$ And And And And Eqv And ),@âÝ€€ÿf2,322),@Wyacoord(2,My&*6+5+2)) ~Evnt_timer(20) Gosub Pbox(@Wxacoord(2,2),@Wyacoord(2,My&*6+2),@Wxacoord(2,322),@Wyacoord(2,My&*6+5+$ And And And And Eqv And )) @Lshowm Wend Graphmode (1) ' If Mk&=1 Edited!(1)=True If X%=1 Vid$=Left$(Vid$,My&*40)+Mid$(Vid$,(My&+1)*40+1)+String$(40,0) Else Vid$=Left$(Vid$,(My&+1)*40)+Mid$(Vid$,My&*40+1) Vid$=Left$(Vid$,1000) Endif Rdw_all(2) @Caremouse Endif Endif ' Clr Mk&,Mx&,My&,A%,B% ~@Wind_update01(0) Gosub Defmouse(0) Return Procedure V.id Local Mx&,My&,Mk&,X%,A% Local A& ' ~@Wind_update01(0) X%=@Form_alert(1,"[2][|"+"D‚truire ou ins‚rer une colonne? |][ Delete | Insert | Annuler ]") ' If X%<>3 @Caremouse ~@Wind_update01(1) Gosub Defmouse(7) ' Clr Mx&,My&,Mk& ~@Infow(2,"Clic g: position / Clic d: annuler") Graphmode (3) While Mk&=0 ~@Graf_mkstate(Mx&,My&,Mk&,A&) Graphmode (1) Gosub Coord(Mx&,My&) ! afficher coord? Graphmode (3) Mx&=Min(39,Max(0,(@Wxrcoord(2,Mx&)-2)\8)) My&=Min(24,Max(0,(@Wyrcoord(2,My&)-2)\6)) ' @Lhidem Gosub Pbox(@Wxacoord(2,Mx&*8+2),@Wyacoord(2,2),@Wxacoord(2,Mx&*8+7+2),@Wyacoord(2,152)) ~Evnt_timer(20) Gosub Pbox(@Wxacoord(2,Mx&*8+2),@Wyacoord(2,2),@Wxacoord(2,Mx&*8+7+2),@Wyacoord(2,152)) @Lshowm Wend Graphmode (1) ' If Mk&=1 Gr.do Edited!(1)=True If X%=1 ' For A%=0 To 24 Mid$(Vid$,(A%*40)+1,40)=Mid$(Vid$,(A%*40)+1,Mx&)+Mid$(Vid$,(A%*40)+2+Mx&,40-Mx&-1)+Chr$(0) Next A% Else For A%=0 To 24 Mid$(Vid$,(A%*40)+1,40)=Mid$(Vid$,(A%*40)+1,Mx&+1)+Mid$(Vid$,(A%*40)+1+Mx&,40-Mx&) Next A% ' Endif Rdw_all(2) @Caremouse Endif Endif ' Clr Mk&,Mx&,My&,A%,B% ~@Wind_update01(0) Gosub Defmouse(0) Return ' ' Procedure Invert.shf Local E% ' ~@Wind_update01(1) Gosub Defmouse(2) Void Fre(0) ' ~Fre() ' Rout1%=Varptr(Rinv$) E%=Varptr(Vid$) ~C:Rinv%(L:E%) Gosub Defmouse(0) Edited!(1)=True ~@Wind_update01(0) Return ' Procedure Down.shf ~@Wind_update01(1) Gosub Defmouse(2) Void Fre(0) T$=Right$(Vid$,40) Vid$=T$+Left$(Vid$,960) Edited!(1)=True Gosub Defmouse(0) ~@Wind_update01(0) Return Procedure Up.shf ~@Wind_update01(1) Gosub Defmouse(2) Void Fre(0) T$=Left$(Vid$,40) Vid$=Right$(Vid$,960)+T$ Clr T$ Edited!(1)=True Gosub Defmouse(0) ~@Wind_update01(0) Return Procedure Right.shf Local E% ' ~@Wind_update01(1) Gosub Defmouse(2) Void Fre(0) ' ~Fre() ' Rout1%=Varptr(Rlsr$) E%=Varptr(Vid$) ~C:Rlsr%(L:E%) Edited!(1)=True Gosub Defmouse(0) ~@Wind_update01(0) Return Procedure Left.shf Local E% ' ~@Wind_update01(1) Gosub Defmouse(2) Void Fre(0) ' ~Fre() ' Rout1%=Varptr(Rlsl$) E%=Varptr(Vid$) ~C:Rlsl%(L:E%) Edited!(1)=True Gosub Defmouse(0) ~@Wind_update01(0) Return ' Procedure Ss.right Local E% ' ~@Wind_update01(1) Gosub Defmouse(2) Void Fre(0) ' ~Fre() ' Rout1%=Varptr(Ssright$) E%=Varptr(Vid$) ~C:Ssright%(L:E%) Edited!(1)=True Gosub Defmouse(0) ~@Wind_update01(0) Return Procedure Ss.down Local E% ' ~@Wind_update01(1) Gosub Defmouse(2) Void Fre(0) ' ~Fre() ' Rout1%=Varptr(Ssdown$) E%=Varptr(Vid$) ~C:Ssdown%(L:E%) Edited!(1)=True Gosub Defmouse(0) ~@Wind_update01(0) Return Procedure Ss.left Gosub Hflip Gosub Vflip Gosub Ss.right Gosub Vflip Gosub Hflip Return Procedure Ss.up Gosub Vflip Gosub Ss.down Gosub Vflip Return ' Procedure Vflip Local A&,E%,T$ ' T$=Vid$ For A&=0 To 24 Mid$(Vid$,A&*40+1)=Mid$(T$,(24-A&)*40+1,40) Next A& Void Fre(0) ' ~Fre() ' Rout1%=Varptr(Hflip$) E%=Varptr(Vid$) ~C:Hflip%(L:E%) ' Return Procedure Hflip Local E% ' Void Fre(0) ' ~Fre() ' Rout1%=Varptr(Vflip$) E%=Varptr(Vid$) ~C:Vflip%(L:E%) Void Fre(0) ' Rout1%=Varptr(Rinv$) E%=Varptr(Vid$) ~C:Rinv%(L:E%) ' Return ' Procedure Load.swt Local A%,X%,N%,Y%,C% Local File$ ' y=version ' go menu.info("Charger") File$=@Fsel$("\*.SWT",File$(0),"Charger swt") Gosub Defmouse(2) ' If Len(File$)>0 If @Exist(File$) File$(0)=File$ ' Erase Page$(),Binair$() Erase Pag_adr%(),Pag_len&(),Pag_ind&() Clr Proc$ Clr Vid$ @Clr_eb Edited!(0)=False @Test_menu ' @Menu_set Gosub Page_manage(0) Rdw_all(0) ' ~@Wind_update01(1) Erreur!=False Open "I",#1,File$(0) If Lof(#1)>4 ' If Inp%(#1)=0 If Input$(7,#1)="SSWEET1" Y%=Inp(#1)-48 Seek #1,16 If Y%<=3 ! version? ' Fmshow("Chargement du programme") Clr A%,X%,N% While ((Erreur!=False) And (Eof(#1)=0)) And (A%+10 T$="' ¨"+T$ Inc C% Endif Else T$="' ¨¨"+T$ Inc C% Endif Endif Page$(A%)=T$ Next A% Gosub Defmouse(0) Clr T$ ' If C%>0 ~@Form_alert(1,"[3][|"+Str$(C%)+" erreur"+"s d‚cel‚es. |][Confirmer]") Endif ' Endif ! fin anc.version ' Gosub Top(0) Gosub Indentage Rdw_all(0) Gosub Comm.info("Charger *.SWT","Charg‚: "+Right$(File$(0),30)) @Page_set Wsetsl(0) Else ~@Form_alert(1,@Errf$(35)) Endif Else ~@Form_alert(1,@Errf$(35)) Endif Else If Lof(#1)=1006 ~@Form_alert(1,"[1][|"+"Source *.EGR... |Chargez le avec L|dans l'‚diteur graphique][ Not‚ ]") Else ~@Form_alert(1,@Errf$(35)) Endif Endif Close #1 ' Else Close #1 ~@Form_alert(1,@Errf$(35)) Endif ' Else ~@Form_alert(1,@Errf$(-33)) Gosub Comm.info("Charger *.SWT","Fichier introuvable") Endif ' Else Gosub Comm.info("Charger *.SWT","annul‚") Endif Erreur!=False Gosub Defmouse(0) ~@Wind_update01(0) Gosub Drawt(0) Return ' ' Gestionnaire de sauvegarde multiples Function Env_save $F% Local A&,N& ' Char{Ob_spec(Adr%(25),Sg_title&)}="Sauvegarde" ' Ob_flags(Adr%(25),Sg_cmp&)=Bclr(Ob_flags(Adr%(25),Sg_cmp&),0) ' If Edited!(0) Ob_state(Adr%(25),Sg_src&)=Bset(Ob_state(Adr%(25),Sg_src&),0) Else Ob_state(Adr%(25),Sg_src&)=Bclr(Ob_state(Adr%(25),Sg_src&),0) Endif If Edited!(1) Ob_state(Adr%(25),Sg_grf&)=Bset(Ob_state(Adr%(25),Sg_grf&),0) Else Ob_state(Adr%(25),Sg_grf&)=Bclr(Ob_state(Adr%(25),Sg_grf&),0) Endif If Edited!(2) Ob_state(Adr%(25),Sg_drcs&)=Bset(Ob_state(Adr%(25),Sg_drcs&),0) Else Ob_state(Adr%(25),Sg_drcs&)=Bclr(Ob_state(Adr%(25),Sg_drcs&),0) Endif If Edited!(9) Ob_state(Adr%(25),Sg_cmp&)=Bset(Ob_state(Adr%(25),Sg_cmp&),0) Else Ob_state(Adr%(25),Sg_cmp&)=Bclr(Ob_state(Adr%(25),Sg_cmp&),0) Endif If Edited!(10) Ob_state(Adr%(25),Sg_seg&)=Bset(Ob_state(Adr%(25),Sg_seg&),0) Else Ob_state(Adr%(25),Sg_seg&)=Bclr(Ob_state(Adr%(25),Sg_seg&),0) Endif ' Ob_flags(Adr%(25),Sg_bit&)=Bset(Ob_flags(Adr%(25),Sg_bit&),7) ' For A&=0 To 5 If Len(Binair$(A&))=0 Ob_state(Adr%(25),Sg_1&+A&)=Bset(Ob_state(Adr%(25),Sg_1&+A&),3) Else Ob_state(Adr%(25),Sg_1&+A&)=Bclr(Ob_state(Adr%(25),Sg_1&+A&),3) Endif Ob_state(Adr%(25),Sg_1&+A&)=Bclr(Ob_state(Adr%(25),Sg_1&+A&),0) Next A& If Edited!(0) Ob_state(Adr%(25),Sg_src&)=Bset(Ob_state(Adr%(25),Sg_src&),0) Else Ob_state(Adr%(25),Sg_src&)=Bclr(Ob_state(Adr%(25),Sg_src&),0) Endif Exdo!=True If Not Erreur! A&=Byte(@Form_wdo(25,0)) Else Ob_flags(Adr%(25),1)=Bclr(Ob_flags(Adr%(25),1),7) Ob_flags(Adr%(25),2)=Bclr(Ob_flags(Adr%(25),2),7) ~Form_center(Adr%(25),Rx&(25),Ry&(25),Rw&(25),Rh&(25)) ~Objc_draw(Adr%(25),0,7,Rx&(25),Ry&(25),Rw&(25),Rh&(25)) Do A&=Byte(Form_do(Adr%(25),0)) If Not Btst(Ob_state(Adr%(25),A&),14) ! D‚placer formulaire Exit if True Endif Loop Endif ~@Wind_update01(0) N&=A& Ob_state(Adr%(25),A&)=Bclr(Ob_state(Adr%(25),A&),0) If Not Erreur! ~@Form_wdo(25,-3) Else ~Form_dial(3,0,0,0,0,Rx&(25),Ry&(25),Rw&(25),Rh&(25)) Endif Gosub W_rdexe If A&=Sg_ok& ! tout sauver ' If Btst(Ob_state(Adr%(25),Sg_src&),0) @Save.swt Endif ' If Btst(Ob_state(Adr%(25),Sg_grf&),0) @Save.egr Endif ' If Btst(Ob_state(Adr%(25),Sg_drcs&),0) @Save.sfd(0) Endif ' If Btst(Ob_state(Adr%(25),Sg_seg&),0) @Save.sgm Endif ' For A&=0 To 5 Actb&=A& If Btst(Ob_state(Adr%(25),Sg_1&+A&),0) @Save.vdt Endif Next A& ' Endif ' Return (N&=Sg_ok&) Endfunc Function Env_load $F% Local A&,N& ' Char{Ob_spec(Adr%(25),Sg_title&)}="Chargement" ' Ob_flags(Adr%(25),Sg_cmp&)=Bclr(Ob_flags(Adr%(25),Sg_cmp&),0) ' Ob_state(Adr%(25),Sg_src&)=Bclr(Ob_state(Adr%(25),Sg_src&),0) Ob_state(Adr%(25),Sg_grf&)=Bclr(Ob_state(Adr%(25),Sg_grf&),0) Ob_state(Adr%(25),Sg_drcs&)=Bclr(Ob_state(Adr%(25),Sg_drcs&),0) Ob_state(Adr%(25),Sg_cmp&)=Bclr(Ob_state(Adr%(25),Sg_cmp&),0) Ob_state(Adr%(25),Sg_seg&)=Bclr(Ob_state(Adr%(25),Sg_seg&),0) Ob_flags(Adr%(25),Sg_bit&)=Bclr(Ob_flags(Adr%(25),Sg_bit&),7) ' For A&=0 To 5 Ob_state(Adr%(25),Sg_1&+A&)=Bclr(Ob_state(Adr%(25),Sg_1&+A&),0) Ob_state(Adr%(25),Sg_1&+A&)=Bclr(Ob_state(Adr%(25),Sg_1&+A&),3) Next A& ' Ob_state(Adr%(25),Sg_1&+Actb&)=Bset(Ob_state(Adr%(25),Sg_1&+Actb&),0) Ob_state(Adr%(25),Sg_src&)=Bclr(Ob_state(Adr%(25),Sg_src&),0) Exdo!=True A&=Byte(@Form_wdo(25,0)) ~@Wind_update01(0) N&=A& Ob_state(Adr%(25),A&)=Bclr(Ob_state(Adr%(25),A&),0) ' ~form_dial(3,0,0,0,0,Rx&(25),Ry&(25),Rw&(25),Rh&(25)) ~@Form_wdo(25,-3) Gosub W_rdexe If A&=Sg_ok& ! charger ' If Btst(Ob_state(Adr%(25),Sg_src&),0) A&=912 If Help! Gosub Help(0,A&) ' a=0 -> annul‚ Endif If A&>0 @Top(0) @Load.swt Endif Endif ' If Btst(Ob_state(Adr%(25),Sg_grf&),0) A&=76 If Help! Gosub Help(2,A&) ' a=0 -> annul‚ Endif If A&>0 @Top(2) @Load.egr Endif Endif ' If Btst(Ob_state(Adr%(25),Sg_drcs&),0) A&=166 If Help! Gosub Help(5,A&) ' a=0 -> annul‚ Endif If A&>0 @Top(5) @Load.sfd(0) Endif Endif ' If Btst(Ob_state(Adr%(25),Sg_seg&),0) Set_minid!=True Recept!=False @Top(4) @Load.sgm Endif ' If Btst(Ob_state(Adr%(25),Sg_bit&),0) @Top(6) @Load.bit(False) Endif ' For A&=0 To 5 Actb&=A& If Btst(Ob_state(Adr%(25),Sg_1&+A&),0) @Load.vdt Endif Next A& ' Endif ' Return (N&=Sg_ok&) Endfunc ' ' ' ********************Sauvegardes******************* ' ' Ce bloc sera rempli de RTS/NOP en version d‚mo! ' ALT V='¯' (175) Procedure Save.swt Local A%,H%,E% Local A$ Local File$ Local A! ' A!=False If Left$(File$(0),1)=Chr$(0) File$(0)=Mid$(File$(0),2) File$=File$(0) A!=True Else ' go menu.info("Sauver") File$=@Fsel$("\*.SWT",File$(0),"Sauver swt") Endif ' If Len(File$)>0 If @Exist(File$) If Not A! If @Form_alert(2,"[3][|"+"Ce fichier existe d‚j…, |l'effacer? ][ Confirmer| Annuler ]")<>1 File$="" Else If Not @Back(File$) ! erreur File$="" Endif Endif Endif Endif ' If Len(File$)>0 File$(0)=File$ Erreur!=False ' ' Open "o",#1,File$ A$=File$(0)+Chr$(0) E%=Gemdos(60,L:Varptr(A$),0) ! create ' If E%=>0 ! pas d'erreur H%=E% ! handle ' ' If H%=>0 ! pas d'erreur Gosub Defmouse(2) ~@Wind_update01(1) ! aprŠs le open!! ' ' A$=Mkl$(0)+"SSWEET13"+Mkl$(0) E%=Gemdos(64,H%,L:Len(A$),L:Varptr(A$)) ' If E%=Len(A$) ! ecr ok? ' ' While (Erreur!=False) And A%<=MaxTy&-2 Clr A% Progress(False,0,"Sauvegarde en cours") While A%<=Maxty&-2 ' Exit if Erreur!=True ' Print #1,Mki$(Len(Page$(A%)));Page$(A%); A$=Mki$(Len(Page$(A%)))+Page$(A%) E%=Gemdos(64,H%,L:Len(A$),L:Varptr(A$)) Exit if E%<>Len(A$) Inc A% ' If Mod(A%,16)=0 Progress(False,(A%*100)\(Maxty&-2),"") Endif ' Wend Progress(True,0,"") ' If Erreur!=False If E%=Len(A$) ' Print #1,Mki$(-1); A$=Mki$(-1) E%=Gemdos(64,H%,L:Len(A$),L:Varptr(A$)) Else ~@Form_alert(1,@Errf$(E%)) Endif ' Endif ' Endif ' Endif ' Close #1 E%=Gemdos(62,H%) ! fermer ' If E%=>0 ' Edited!(0)=False ! src sauv‚ @Test_menu ' @Menu_set Gosub Comm.info("Sauver *.SWT","Fichier sauv‚") Else ~@Form_alert(1,@Errf$(E%)) Gosub Comm.info("Sauver *.SWT","*Erreur #"+Str$(E%)) Endif ' Else If E%<0 ~@Form_alert(1,@Errf$(E%)) Gosub Comm.info("Sauver *.SWT","*Erreur #"+Str$(E%)) Else ~@Form_alert(1,@Errf$(-1)) Gosub Comm.info("Sauver *.SWT","*Erreur #"+Str$(-1)) Endif E%=Gemdos(62,H%) ! fermer Endif ' Else ! ereur en open ~@Form_alert(1,@Errf$(E%)) Gosub Comm.info("Sauver *.SWT","*Erreur #"+Str$(E%)) Endif ' Endif Endif ' Erreur!=False Gosub Defmouse(0) ~@Wind_update01(0) Gosub Drawt(0) ' Return Procedure Save.egr Local File$ ' Clr Erreur! ' go menu.info("Sauver") File$=@Fsel$("\*.EGR",File$(1),"Sauver graphique") ' If Len(File$)>0 Gosub Defmouse(2) If @Exist(File$) Gosub Defmouse(0) If @Form_alert(2,"[3][|"+"Ce fichier existe d‚j…, |l'effacer? ][ Confirmer| Annuler ]")<>1 File$="" Else If Not @Back(File$) ! erreur File$="" Endif Endif Gosub Defmouse(2) Endif If Len(File$)>0 File$(1)=File$ ' Open "o",#1,File$ A$=File$(1)+Chr$(0) E%=Gemdos(60,L:Varptr(A$),0) ! create If E%=>0 H%=E% ~@Wind_update01(1) ' ' Print #1,"EDITX1"; A$="EDITX1" E%=Gemdos(64,H%,L:Len(A$),L:Varptr(A$)) If E%=Len(A$) ! ecr ok? ' Print #1,Vid$; E%=Gemdos(64,H%,L:Len(Vid$),L:Varptr(Vid$)) If E%=Len(Vid$) Edited!(1)=False Gosub Comm.info("Sauver *.EGR","Ecran sauv‚") Endif ' Else ! erreur d'‚criture If E%<0 ~@Form_alert(1,@Errf$(E%)) Gosub Comm.info("Sauver *.EGR","*Erreur #"+Str$(E%)) ~@Infow(2,"Erreur #"+Str$(E%)+" - ‚cran non sauv‚") Else ~@Form_alert(1,@Errf$(-1)) Gosub Comm.info("Sauver *.EGR","*Erreur #"+Str$(-1)) ~@Infow(2,"Erreur #"+Str$(E%)+" - ‚cran non sauv‚") Endif Endif ' ' Close #1 E%=Gemdos(62,H%) ! fermer If E%<0 ! erreur en fermant ~@Form_alert(1,@Errf$(E%)) Gosub Comm.info("Sauver *.EGR","*Erreur #"+Str$(E%)) ~@Infow(2,"Erreur #"+Str$(E%)+" - ‚cran non sauv‚") Endif ' Else ! erreur en cr‚ant ~@Form_alert(1,@Errf$(E%)) Gosub Comm.info("Sauver *.EGR","*Erreur #"+Str$(E%)) ~@Infow(2,"Erreur #"+Str$(E%)+" - ‚cran non sauv‚") Endif Endif ' Gosub Defmouse(0) ~@Wind_update01(0) Rdw_all(2) Else Gosub Comm.info("Sauver *.EGR","annul‚") Endif ' ' Return Procedure Save.vdt Local A% Local File$ Local C& ' ' If Len(Binair$(Actb&))>0 ' go menu.info("Sauver "+Str$(Actb&+1)) If Left$(File$(2),1)<>"*" File$=@Fsel$("\*.VDT",File$(2),"Sauver vdt "+Str$(Actb&+1)) Gosub Defmouse(2) Else File$=File$(2) Endif ' If Len(File$)>0 ' If Left$(File$,1)<>"*" If @Exist(File$) If @Form_alert(2,"[3][|"+"Ce fichier existe d‚j…, |l'effacer? ][ Confirmer| Annuler ]")<>1 File$="" Else If Not @Back(File$) ! erreur File$="" Endif Endif Endif Else File$=Mid$(File$,2) Endif ' If Len(File$)>0 File$(2)=File$ Erreur!=False ~@Wind_update01(0) Open "O",#1,File$(2) ~@Wind_update01(1) If Erreur!=False If Acc!=False ! ascii A%=1 ' For A%=1 To Len(Binair$(Actb&)) Repeat ' @Untran(Mid$(Binair$(Actb&),A%,128)) C&=Asc(Mid$(Binair$(Actb&),A%,1)) ' $S& Select C& Case 22,25 Add A%,1 Select Mid$(Binair$(Actb&),A%,1) Case "z" C&=Asc("´") Case "j" C&=Asc("µ") Case "'" C&=Asc("Ý") Case "#" C&=Asc("œ") Case "<" C&=Asc("¬") Case "=" C&=Asc("«") Case ">" C&=Asc("þ") Case "." C&=Asc("¯") Case "," C&=Asc("®") Case "{" C&=Asc("ž") Case "1" C&=Asc("ñ") Case "8" C&=Asc("ö") Case "0" C&=Asc("ø") ' Case "A","B","C","H","K" ! suivants Add A%,1 Select Mid$(Binair$(Actb&),A%-1,2) Case "Be" C&=Asc("‚") Case "Aa" C&=Asc("…") Case "Ae" C&=Asc("Š") Case "Au" C&=Asc("—") Case "Ha" C&=Asc("„") Case "He" C&=Asc("‰") Case "Hi" C&=Asc("‹") Case "Ho" C&=Asc("”") Case "Hu" C&=Asc("š") Case "Ca" C&=Asc("ƒ") Case "Ce" C&=Asc("ˆ") Case "Ci" C&=Asc("Œ") Case "Co" C&=Asc("“") Case "Cu" C&=Asc("–") Case "Kc" C&=Asc("‡") Endselect Endselect Endselect ' Print #1,Chr$(C&); $S% ' Next A% Inc A% Until A%>Len(Binair$(Actb&)) ' Else ! vdt For A%=1 To Len(Binair$(Actb&))+127 Step 128 ' Print #1,@Tran$(Mid$(Binair$(Actb&),A%,1)); @Tran(Mid$(Binair$(Actb&),A%,128)) Print #1,Tr_t$; ' Exit if Erreur!=True Next A% Endif Endif Edited!(Actb&+3)=False ! sauv‚! Close #1 Gosub Comm.info("Sauver *.VDT","Bloc VDT sauv‚") Endif ' Else Gosub Comm.info("Sauver *.VDT","annul‚") Endif Erreur!=False Gosub Defmouse(0) ~@Wind_update01(0) ' Else Gosub Comm.info("Sauver *.VDT","bloc vide!") @Beep Endif ' Return Procedure Save.lsw Local A% Local File$ ' ' ' go menu.info("Charger") File$=@Fsel$("\*.LSW",File$(3),"Sauver swt,L") Gosub Defmouse(2) ' If Len(File$)>0 ' If @Exist(File$) If @Form_alert(2,"[3][|"+"Ce fichier existe d‚j…, |l'effacer? ][ Confirmer| Annuler ]")<>1 File$="" Else If Not @Back(File$) ! erreur File$="" Endif Endif Endif ' If Len(File$)>0 File$(3)=File$ Erreur!=False ~@Wind_update01(0) Open "O",#1,File$(3) ~@Wind_update01(1) Clr A% While (Erreur!=False) And A%<=Maxty&-2 Exit if Erreur!=True Print #1,Space$(Pag_ind&(A%))+@Defm$(A%) Inc A% ' If Mod(A%,8)=0 Gosub Defmouse(2) ! anim Endif ' Wend Close #1 Gosub Comm.info("Sauver *.LSW","Fichier sauv‚") Endif ' Else Gosub Comm.info("Sauver *.LSW","annul‚") Endif Erreur!=False Gosub Defmouse(0) ~@Wind_update01(0) ' ' Return Procedure Save.sfd(Flag!) Local A&,B&,C&,T& Local E$ Local File$ ' ' E$=String$(188,&HFF) ! 94*2 If Flag! Chs_set(True) E$=@Chsel$("sauver") Endif ' If Len(E$)>0 File$=@Fsel$("\*.SFD",File$(4),"Sauver caractŠres") If Len(File$)>0 File$(4)=File$ Gosub Defmouse(2) Open "O",#1,File$(4) Print #1,"SWT2DRCS"; Clr T& For C&=0 To 1 For B&=0 To 93 If Asc(Mid$(E$,B&+C&*94+1,1))=&HFF ! load it? Print #1,Chr$(C&); Print #1,Chr$(B&); For A&=0 To 9 Print #1,Chr$(Drcs|(C&,B&,A&)); Next A& Inc T& Endif Next B& ' Next C& Edited!(2)=False ! sauv‚ Close #1 Gosub Defmouse(0) Gosub Comm.info("Sauver *.SFD",Str$(T&)+" caractŠres sauv‚s") ~@Infow(5,Str$(T&)+" caractŠres sauv‚s") Endif Else Gosub Comm.info("Sauver *.SFD","annul‚") Endif ' ' Return Procedure Save.sfv(Flag!) Local A&,C&,T& Local E$,A$,B$ Local File$ ' ' E$=String$(188,&HFF) ! 94*2 If Flag! Chs_set(True) E$=@Chsel$("exporter") Endif ' If Len(E$)>0 File$=@Fsel$("\*.VDT",File$(2),"Sauver fonte ‚xecutable") ' If Len(File$)>0 If @Exist(File$) If @Form_alert(2,"[3][|"+"Ce fichier existe d‚j…, |l'effacer? ][ Confirmer| Annuler ]")<>1 File$="" Else If Not @Back(File$) ! erreur File$="" Endif Endif Endif ' If Len(File$)>0 File$(2)=File$ ' Gosub Defmouse(2) Open "O",#1,File$(2) ~@Infow(5,"Transcription en cours...") Clr A$,B$ Clr T& For C&=0 To 1 For B&=0 To 93 If Asc(Mid$(E$,B&+C&*94+1,1))=&HFF ! send it? If C&=0 A$=A$+Chr$(B&) Else B$=B$+Chr$(B&) Endif Inc T& Endif Next B& Next C& ' ~@Infow(5,"Sauvegarde en cours...") Gosub Defmouse(2) If Len(A$)>0 ~@Infow(5,"Sauvegarde en cours... FONTE TEXTE") Print #1,@Telchar$(0,A$); Endif If Len(B$)>0 ~@Infow(5,"Sauvegarde en cours... FONTE GRAPH") Print #1,@Telchar$(1,B$); Endif ~@Infow(5,"Sauvegarde effectu‚e") Close #1 Gosub Defmouse(0) Gosub Comm.info("Sauver fonte *.VDT",Str$(T&)+" caractŠres sauv‚s") ~@Infow(5,Str$(T&)+" caractŠres sauv‚s") ' Endif Endif Endif ' ' Return ' ' ************************************************** ' Procedure Load.egr Local E% Local File$ ' Clr Erreur! ' go menu.info("Charger") File$=@Fsel$("\*.EGR",File$(1),"Charger graphique") ' If Len(File$)>0 If @Exist(File$) File$(1)=File$ Fmshow("Chargement du graphique") ~@Wind_update01(1) Gosub Defmouse(2) Open "I",#1,File$(1) ' If Lof(#1)=1006 If (Input$(6,#1)="EDITX1") And (Erreur!=False) Vid$=Input$(1000,#1) Edited!(1)=False ' Void Fre(0) ' ~Fre() ' Rout1%=Varptr(Tst63$) E%=Varptr(Vid$) If C:Tst63%(L:E%) Vid$=String$(1000,0) ~@Wind_update01(0) ~@Form_alert(1,@Errf$(35)) Endif Edited!(1)=False Gosub Comm.info("Charger *.EGR","Charg‚: "+Right$(File$(1),30)) ~@Wind_open(2) ' Else ~@Wind_update01(0) ~@Form_alert(1,@Errf$(35)) Endif Else ~@Wind_update01(0) If Lof(#1)>6 If Input$(11,#1)=Mkl$(0)+"SSWEET1" ~@Form_alert(1,"[1][|"+"Source *.SWT... |Chargez le avec ^L|][ Not‚ ]") Else ~@Form_alert(1,@Errf$(35)) Endif Else ~@Form_alert(1,@Errf$(35)) Endif Endif ' Close #1 Gosub Defmouse(0) ~@Wind_update01(0) Fmhide Gosub Top(2) Rdw_all(2) ' Else ~@Form_alert(1,@Errf$(-33)) Gosub Comm.info("Charger *.EGR","Fichier introuvable") Endif ' Else Gosub Comm.info("Charger *.EGR","annul‚") Endif ' Return Procedure Load.vdt Local File$ ' ' go menu.info("Charger "+Str$(Actb&+1)) File$=@Fsel$("\*.VDT",File$(2),"Charger vdt "+Str$(Actb&+1)) ~@Wind_update01(1) Gosub Defmouse(2) ' If Len(File$)>0 If @Exist(File$) File$(2)=File$ ' Fmshow("Chargement du bloc vid‚otex") Erreur!=False Open "I",#1,File$(2) If Lof(#1)<=32000 Binair$(Actb&)=Input$(Lof(#1),#1) Gosub Comm.info("Charger *.VDT","Charg‚,"+Str$(Actb&+1)+": "+Right$(File$(2),30)) Gosub Comm.info("M","Bloc VDT actuel: "+Str$(Actb&+1)+", longueur: "+Str$(Len(Binair$(Actb&)))+" octets.") Edited!(Actb&+3)=False Else If @Form_alert(1,"[2][|Fichier trop gros! |Charger le d‚but? |][Confirmer| Annuler ]")=1 Binair$(Actb&)=Input$(32000,#1) Gosub Comm.info("Charger *.VDT","Charg‚,"+Str$(Actb&+1)+": "+Right$(File$(2),30)) Gosub Comm.info("M","Bloc VDT actuel: "+Str$(Actb&+1)+", longueur: "+Str$(Len(Binair$(Actb&)))+" octets.") Edited!(Actb&+3)=False Else Gosub Comm.info("Charger *.VDT","annul‚") Endif Endif Close #1 ~@Wind_update01(0) Fmhide ' Else ~@Form_alert(1,@Errf$(-33)) Gosub Comm.info("Charger *.VDT","Fichier introuvable") Endif If Wopen!(1) Rdw_all(1) Endif ' Else Gosub Comm.info("Charger *.VDT","annul‚") Endif Erreur!=False Gosub Defmouse(0) ~@Wind_update01(0) Return Procedure Load.lsw Local A%,C%,N% Local T$ Local File$ ' ' go menu.info("Sauver") File$=@Fsel$("\*.LSW",File$(3),"Charger swt,L") ~@Wind_update01(1) Gosub Defmouse(2) ' If Len(File$)>0 If @Exist(File$) File$(3)=File$ Fmshow("Chargement du programme") Erreur!=False Open "I",#1,File$(3) ' Erase Page$(),Binair$() Erase Pag_adr%(),Pag_len&(),Pag_ind&() Clr Proc$ Clr Vid$ @Clr_eb Edited!(0)=False @Test_menu ' @Menu_set Gosub Page_manage(0) Rdw_all(0) ' A%=0 Clr N% ! nb tours (verify) While (Erreur!=False) And (Not Eof(#1)) And (A%+10 Page$(A%)=T$ Exit if Erreur!=True Page$(A%)=@Epure$(Page$(A%)) Inc A% ' If Mod(A%,8)=0 Gosub Defmouse(2) ! anim Endif Endif ' If Mod(N%,8)=0 If Fre()0 T$=@Abrev$(T$,X%) If X%=0 If @Testi(T$)<>0 T$="' ¨"+T$ Inc C% Endif Else T$="' ¨"+T$ Inc C% Endif Page$(B%)=T$ Endif Next B% ' ~@Wind_update01(0) Fmhide @Page_set Gosub Comm.info("Charger *.LSW","Charg‚: "+Right$(File$(3),30)) Wsetsl(0) Ty&=0 Clr Terr$,Terrp& Gosub Defmouse(0) Gosub Top(0) Gosub Indentage Rdw_all(0) ' If C%>0 ~@Form_alert(1,"[3][|"+Str$(C%)+" erreur"+"s d‚cel‚es. |][Confirmer]") Endif Clr A%,C%,B% ' Else ~@Form_alert(1,@Errf$(-33)) Gosub Comm.info("Charger *.LSW","Fichier introuvable") Endif Else Gosub Comm.info("Charger *.LSW","annul‚") Endif Erreur!=False ' Gosub Defmouse(0) ~@Wind_update01(0) Return Procedure Insert.lsw Local A%,C%,N% Local T$ Local File$ ' ' go menu.info("Merge") File$=@Fsel$("\*.LSW",File$(3),"Ins‚rer swt,L") ~@Wind_update01(1) Gosub Defmouse(2) ' If Len(File$)>0 If @Exist(File$) File$(3)=File$ Erreur!=False Open "I",#1,File$(3) ' A%=Ty& Clr N% ! nb tours (verify) While (Erreur!=False) And (Not Eof(#1)) And (A%0 Insert Page$(A%)=T$ Exit if Erreur!=True Page$(A%)=@Epure$(Page$(A%)) Inc A% ' If Mod(A%,8)=0 Gosub Defmouse(2) ! anim Endif Endif ' If Mod(N%,8)=0 If Fre()0 T$=@Abrev$(T$,X%) If X%=0 If @Testi(T$)<>0 T$="' ¨"+T$ Inc C% Endif Else T$="' ¨"+T$ Inc C% Endif Page$(B%)=T$ Endif Next B% ' @Page_set Gosub Comm.info("M","Fichier ins‚r‚") Wsetsl(0) ' Ty&=0 Clr Terr$,Terrp& Gosub Defmouse(0) Gosub Top(0) Rdw_all(0) ' If C%>0 ~@Form_alert(1,"[3][|"+Str$(C%)+" erreur"+"s d‚cel‚es. |][Confirmer]") Endif Clr A%,C%,B% ' Else ~@Form_alert(1,@Errf$(-33)) Gosub Comm.info("Ins‚rer *.LSW","Fichier introuvable") Endif Else Gosub Comm.info("Ins‚rer *.LSW","annul‚") Endif Erreur!=False ' Gosub Defmouse(0) ~@Wind_update01(0) Return ' ' Recevoir Procedure Recept Local Index& ' If Capt|<>0 If Capt|=1 Index&=@Form_alert(1,"[3][|"+"Capture en cours...|Taille: "+Str$(Len(Binair$(Captb&)))+" octets|][ Arrˆter |Arrˆt page|Continuer]") Else Index&=@Form_alert(1,"[3][|"+"Attente de fin de page...|Taille: "+Str$(Len(Binair$(Captb&)))+" octets|][ Arrˆter |Continuer]") Endif $S& Select Index& Case 1 Capt|=0 ~@Form_alert(1,"[3][|"+"Octets captur‚s: "+Str$(Len(Binair$(Captb&)))+" octets|][Confirmer]") Case 2 Capt|=2 ! arrˆt page Endselect $S% Gosub Comm.info("M","Bloc VDT capture: "+Str$(Captb&+1)+", longueur: "+Str$(Len(Binair$(Captb&)))+" octets.") Else Captb&=Actb& Index&=@Form_alert(1,"[3][|"+"Pret a recevoir |F5 pour arreter.|][ Go #"+Str$(Captb&+1)+" |Arrˆt page| Annuler ]") If Index&<>3 Gosub Menu.info("Capture lanc‚e - bloc "+Str$(Captb&+1)+" effac‚") @Videmntl $S& Select Index& Case 1 Edited!(Captb&+3)=True Binair$(Captb&)="" Capt|=1 Case 2 Edited!(Captb&+3)=True Binair$(Captb&)="" Capt|=2 Endselect $S% Inc Actb& ! Bloc d‚fault If Actb&>5 Actb&=0 ! <>Bloc capture! Endif Gosub Menu.info("Bloc actuel: "+Str$(Actb&+1)) Endif Endif Gosub Drawx(4) ' Return ' Procedure Setactb(N&) If Capt|=0 Actb&=N& Else If Captb&<>N& Actb&=N& Else ~@Form_alert(1,"[3][|Le bloc "+Str$(N&+1)+" est d‚j… utilis‚ |pour la capture! |][ Annuler ]") Endif Endif Return ' ' ' V‚rifier toute la syntaxe du programme Procedure F10 Local B%,C% Local T$ ' Gosub Menu.info("Analyse... [SHIFT]-[SHIFT] pour interrompre") Clr C% B%=0 Repeat If Mod(B%,8)=0 Gosub Defmouse(2) Endif ' T$=Page$(B%) If Len(T$)>0 T$=@Abrev$(T$,X%) If X%=0 If @Testi(T$)<>0 T$="' ¨"+T$ Inc C% Endif Else T$="' ¨"+T$ Inc C% Endif Page$(B%)=T$ Endif Exit if @Shiftbrk2 Inc B% Until B%>Maxty& Gosub Comm.info("M","Fichier analys‚") If C%>0 ~@Form_alert(1,"[3][|"+Str$(C%)+" erreur"+"s d‚cel‚es. |][Confirmer]") Endif ' Return ' Procedure Inistr Local A%,C%,X%,E$ ' Gosub Defmouse(2) Clr Maxi&,List$ ! nbr d'instr, liste = globaux Void Fre(0) ' ' Gosub Analyst1 @Inimnu @Initel ' ' If @Shift=0 And Bios(1,1)=0 ! ctrl ou alt etc..=ne pas envoyer! ' Outvid(Cls$) ' Send(Tv$) ' Endif ' ' Istr&=No id de la derniere ligne (200) ' ->simuler proc‚dure Istr&=200 ' Dim Instr$(Istr&,3),Instr&(Istr&,Dinstr&),Tpi|(Istr&),Procx#(9),Proc$(9) Dim Pageh$(80+2) For A%=0 To Dinstr& Proc$(A%)="" Procx#(A%)=0 Next A% Dim Lst$(Istr&) ! liste Dim Col$(1,7),Ec$(1,7) Col$(0,0)="NOIR" Col$(0,1)="BLEU" Col$(0,2)="ROUGE" Col$(0,3)=Asin( To =Sqr(Rnd(Asin( Col$(0,4)="VERT" Col$(0,5)=At(Asin(Sqr( Col$(0,6)="JAUNE" Col$(0,7)="BLANC" Col$(1,0)="N" Col$(1,1)="BL" Col$(1,2)="R" Col$(1,3)="M" Col$(1,4)="V" Col$(1,5)="C" Col$(1,6)="J" Col$(1,7)="B" Ec$(0,0)="@" Ec$(0,1)="D" Ec$(0,2)="A" Ec$(0,3)="E" Ec$(0,4)="B" Ec$(0,5)="F" Ec$(0,6)="C" Ec$(0,7)="G" Ec$(1,0)="P" Ec$(1,1)="T" Ec$(1,2)="Q" Ec$(1,3)="U" Ec$(1,4)="R" Ec$(1,5)="V" Ec$(1,6)="S" Ec$(1,7)="W" ' Clr Instr.tab$ ! Pour Compile Instr.tab$=Chr$(32) Restore Instr A%=-1 Maxi&=-1 Void Fre(0) Do Inc A% Read Tpi|(A%) ! type instr ' For C%=0 To 3 Read E$ ' Instr$(A%,C%)=E$ If C%=0 And Len(E$)>0 If Left$(E$,4)="SWEE" If Maxi&>0 Maxi&=-Maxi& Endif Else If Maxi&=>-1 Inc Maxi& ! nbr d'instr Lst$(A%)=E$ ! liste Endif Endif Instr.tab$=Instr.tab$+Left$(E$,Tabi&-1)+Space$(Max(0,Tabi&-Len(E$)-1)+1) Endif Next C% ' C%=0 Repeat Read X% If X%=-2 Or X%=True Instr&(A%,C%)=0 C%=True Else Instr&(A%,C%)=X% Endif Exit if C%=True Inc C% Until C%>Dinstr&+1 Loop until X%=True ' ' Instr.tab$=Instr.tab$+String$(20,0) For C%=0 To Dinstr& Instr&(A%,C%)=-1 Next C% ' Maxi&=Abs(Maxi&) Dim Lst%(Istr&) ! liste TEMPO (a cause du qsort!!) Arrayfill Lst%(),-1 For A%=0 To Maxi& Lst%(A%)=A% Next A% Qsort Lst$(),Maxi&+2,Lst%() ! dans l'ordre svp ' ' ð = chr 240 = faux espace, double cliquer sur XXXðYYY donnera XXX YYY (et non pas XXX seulement … cause de l'espace) ' ' mais pas besoin ici Dim Xmenu$(4) Xmenu$(0)="Aide Sweetel 2" Xmenu$(1)="Fonctions num‚riques" Xmenu$(2)="Fonctions alphanum‚riques" Xmenu$(3)="" Xmenu$(4)="" Maxex&=4 ! lignes r‚serv‚es au total (d‚calage) Nxmenu&=3 ' ' Dim Lst&(Istr&+Nxmenu&+4) ! liste Arrayfill Lst&(),-1 ! vide ' For A&=0 To Istr& Lst&(A&+Nxmenu&+2)=Lst%(A&) Next A& Erase Lst$(),Lst%() ' Toti&=Maxi& For A&=0 To Nxmenu&-1 Lst&(A&+2)=-2-A& ! extended menu #0 Next A& ' Inc Toti& ' Add Toti&,5 Add Toti&,Nxmenu&+2 ' Compi&=25 Dim Compinf$(Compi&) Compinf$(1)="Bienvenue sur "+Name$ Compinf$(2)="Version "+Release$+" de "+Reldate$ ' Gosub Clearv Gosub Defmouse(0) ' Dim Edited!(10) ' 0 Editeur ' 1 Graphique ' 2 DRCS ' 3 bloc 1 ' 4 `` 2 ' 5 `` 3 ' 6 `` 4 ' 7 ? ' 8 ? ' 9 Dessin ' 10 SeGMents ' ' Void Fre(0) Return ' Procedure Uninistr ' Erase Intercol&(),Extercol&() Erase Binair$() Erase Instr$(),Instr&(),Col$(),Ec$(),Tpi|(),Lst&(),Proc$(),Procx#() Erase Compinf$(),Macro$(),Macdef%(),Edited!() Erase Pageh$() ' @Closmnu @Closetel Return ' Function Epure$(E$) Local A%,B%,T$,B$ ' If Len(E$)>0 ' E$=Trim$(E$) If Left$(E$,1)=Quote$ If Len(E$)=1 E$="CR" Else E$="TXT "+E$ Endif Endif Clr A%,T$ ' Select Left$(E$,1) Case "'","!","#",";" ' Else ! Rem If Mid$(E$,2,1)<>Chr$(32) E$="' "+Mid$(E$,2) Endif ' If Left$(E$,1)<>"'" And Left$(E$,1)<>"!" Case "{","}","\" If Mid$(E$,2,1)<>Chr$(32) E$=Left$(E$,1)+Chr$(32)+Mid$(E$,2) Endif ' Default ' If Instr(E$,Quote2$)<>0 If Instr(E$,Quote$)=0 Do A%=Instr(E$,Quote2$) Exit if A%=0 Mid$(E$,A%,1)=Quote$ Loop Clr A% Endif Endif ' ' Repl(Quote$+" +",Quote$+"+",E$) ' Repl(Quote$+"+ ",Quote$+"+",E$) ' Repl(Quote$+" + ",Quote$+"+",E$) ' Repl(" + "+Quote$,"+"+Quote$,E$) ' If Instr(E$,Quote$) T$=Mid$(E$,Instr(E$,Quote$)) ' T$=Trim$(T$) ' If Right$(T$,1)<>Quote$ Or Len(T$)=1 ' T$=T$+Quote$ ' Endif ' E$=Mid$(E$,1,Instr(E$,Quote$)-1) Endif E$=Trim$(Upper$(E$)) ' Gosub Sous_ep Clr A% Do B%=A%+1 A%=Instr(E$,"#",B%) Exit if A%65 And B%<=90 Mid$(E$,A%,1)=Chr$(32) Gosub Sous_ep Else B%=Asc(Mid$(E$,A%+1,1)) If B%=>65 And B%<=90 Mid$(E$,A%,1)=Chr$(32) Gosub Sous_ep Endif Endif Loop ' If Left$(E$,1)="@" While Mid$(E$,2,1)=Chr$(32) E$="@"+Mid$(E$,3) Wend Else if Left$(E$,3)="FOR" A%=Instr(E$,"STEP") If A%>0 $S% Select Left$(E$,4)+Chr$(32) Case "FORS" E$=Mid$(E$,1,A%-1)+","+Mid$(E$,A%+4) Gosub Sous_ep Case "FOR " E$=Mid$(E$,1,A%-1)+","+Mid$(E$,A%+4) E$="FORS"+Mid$(E$,4) Gosub Sous_ep Endselect Endif A%=Instr(E$,Chr$(32),4) If A%<>0 If Mid$(E$,A%+2,1)="=" Mid$(E$,A%+2,1)="," Endif Endif ' Else ' Select Left$(E$,4) Case "GOSU" ! b E$="@"+Mid$(E$,7) Case "NEXT" If Len(E$)>4 E$=Left$(E$,4) ! next tout court!! Endif Endselect Endif ' Endselect ' Endif ' Endif ' If (Len(E$)+Len(T$)>0) ' ' e$=partie OPERANDE PARAMx t$=PARAMs If Instr(",+",Right$(E$,1))<>0 E$=E$+T$ Else E$=E$+Chr$(32)+T$ Endif Return E$ Else Return "" Endif ' Endfunc Procedure Sous_ep Local A%,B% ' Repl("TO ",",",E$) ' ' supprimer Chr$(32) superflus ahhlala A%=Instr(E$,Chr$(32)) If A%>0 E$=Left$(E$,A%)+@Strform$(Mid$(E$,A%+1)) Endif ' ' Haha ca c'est l'‚cran cach‚! Repl("SWEETEL","TXT "+Quote$+"Quel beau composeur!"+Quof$+"."+Quote$,E$) Return Procedure Repl(A$,B$,Var E$) Local A% A%=Instr(E$,A$) While A%<>0 E$=Mid$(E$,1,A%-1)+B$+Mid$(E$,A%+Len(A$)) A%=Instr(E$,A$) Wend Return Function Xtrim$(E$) Local A% ' A%=Instr(E$,Chr$(32)) While A%<>0 E$=Left$(E$,A%-1)+Mid$(E$,A%+1) A%=Instr(E$,Chr$(32)) Wend Return E$ ' Endfunc ' ' Remplacer abrev dans ligne instr ' Y: retour, TRUE si instr reconnue Function Abrev$(E$,Var Y%) Local A&,X&,T&,Z&,T$ ' A&=Instr(E$,Chr$(32)) If A&=0 A&=Len(E$)+1 Endif T$=Mid$(E$,1,A&-1) ! instr brute ' X&=0 If Left$(T$,1)="@" X&=-1 ! ne pas v‚rifier: proc Else T&=Instr(E$,Chr$(32)) X&=Instr(E$,"=") If X&<>0 If (T&=0 And X&<>0) Or (T&<>0 And X&0 Or A&>Maxi& ' Loop until T&=>0 Or X&>3 Wend If T&<0 Inc Z& Endif Loop until Z&>1 Or T&=>0 ' If Z&<=1 Y%=0 E$=Instr$(A&,0)+E$ Else Y%=-1 E$=T$+E$ Endif ' Else ' Stop Endif ' Return E$ Endfunc ' ' Tester syntaxe instruction ' reponse: 0 ok >0 pos ou il y a des problemes Function Testi(Var A$) $F% Local A%,C%,D%,Index&,Reponse%,Reponse# Local T$,E$,B$,Instr$ Local X%,Y%,Z% ! pos a Local W% ! plock ' W%=0 Instr$(Istr&,0)="" ' If Len(A$)>0 Clr Reponse%,C%,Index&,B$,T$,Instr$,X%,Terrp&,Terr$ ' E$=A$+Chr$(32) A%=Instr(E$,Chr$(32)) T$=Mid$(E$,1,A%-1) ! Instr BRUTE ' X%=Len(T$)+2 ' ' Pour que le pc soit sur l'espace (=virgule!) Dec X% ' T$=Upper$(Trim$(T$)) E$=Trim$(Mid$(E$,A%)) ! Param BRUT Add Index&,Len(T$)+1 ' Y%=0 ! 0:instruction 1: a=1 2: a$="" 3: proc Select Left$(A$,1) Case "@" ! proc Y%=3 Case "'","{","}","\" Y%=4 ! instr Default Y%=Instr(A$,Chr$(32)) Z%=Instr(A$,"=") If Y%+Z%<>0 And Z%<>0 If (Y%=0 And Z%<>0) Or (Y%<>0 And Z%False If @Test3(E$)<>False A$=B$+"="+E$ Else Reponse%=Terrp& Endif Else Terr$="Nom de variable invalide" Reponse%=1 Endif ' Return Reponse% ' Else if Y%=2 ! $a="" ' B$=Trim$(Left$(A$,Z%-1)) E$=Trim$(Mid$(A$,Z%+1)) If @Test6(B$)<>False If @Test4(E$)<>False A$=B$+"="+E$ Else Reponse%=Terrp& Endif Else Terr$="Nom de variable invalide" Reponse%=1 Endif ' Return Reponse% Else if Y%<>4 ' If Y%=3 ! proc, on traite comme une instruction ' ' t$=instr e$=param (bruts) If @Pproc(Mid$(T$,2))=-1 If Len(Terr$)>0 A%=-1 Endif Gosub Defmouse(2) Gosub Plock ! inventaire Endif A%=@Pproc(Mid$(T$,2)) Gosub Defmouse(0) If A%<>-1 ! trouv‚e A%=Istr& ! on se fout du No de ligne! ' Cela devient une instruction normale! ' Else If Len(Terr$)>0 A%=-1 Endif Endif ' Else ' If Len(T$)>0 T$=T$+Chr$(32) T$=Mid$(T$,1,Instr(T$,Chr$(32))-1) Repeat A%=Instr(Instr.tab$,Chr$(32)+Left$(T$,Tabi&-1)+Chr$(32)) ' If A%<>0 If Not Instr$(Div(A%,Tabi&),0)=T$ A%=-1 Endif Div A%,Tabi& ! pos Else A%=-1 Endif Until A%<>-2 ' Else A%=-1 Endif Endif ' If A%<>-1 ' ' v‚rifier params Clr Terr$,Terrp& ' ' Etendre >5 aussi dans Case 1 (On/Off)=>Test For C%=0 To Dinstr& ' ' Terrx: dans le cas d'instr avec chaines multiples (#,$,#,$..) Clr Terrp&,Terrx& ' ' If Len(E$)>0 B$=@Readp$(E$) ' ' Add Index&,Len(B$) ! Index&=X% If Len(E$)=Len(B$) ! Fin de chaine Clr E$ Else E$=Mid$(E$,Len(B$)+2) Endif Y%=True ! ParamŠtre detect. Else Clr B$ Y%=False ! No detect. Endif ' ' paramx: 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc If Len(B$)=0 And Instr&(A%,C%)<>1 And Instr&(A%,C%)<>0 If Len(Terr$)=0 Terr$="Pas assez de paramŠtres / " ' Select Instr&(A%,C%) Case 1 Terr$=Terr$+"On/Off" Case 2 Terr$=Terr$+"Byte" Case 3 Terr$=Terr$+"Valeur" Case 4 Terr$=Terr$+"String" Case 5 Terr$=Terr$+"Var" Case 6 Terr$=Terr$+"Var$" Case 7 Terr$=Terr$+"Couleur" Case 8 Terr$=Terr$+"1..63" Case 9 Terr$=Terr$+"Nom" Default Terr$=Terr$+"????" ' Endselect ' Reponse%=Len(A$)+1 Exit if True Else Reponse%=Terrp&+Len(A$)+1 Exit if True Endif ' Else ' Z%=Len(B$) B$=@Strform$(B$) ! Epurer ' Select Instr&(A%,C%) Case 0 If Len(B$)<>0 Or Z%<>0 Or Len(E$)<>0 Or Y%=True Terr$="Trop de paramŠtres" Reponse%=X%+1 Exit if True Else Exit if True Endif ' Case 1 If Not @Test1(B$) If Len(Terr$)=0 Terr$="ParamŠtre incorrect"+", ON/OFF "+"attendu" Endif Reponse%=X%+1+Terrp& Exit if True Endif ' Case 2 If Not @Test2(B$) If Len(Terr$)=0 Terr$="ParamŠtre incorrect"+", OCTET "+"attendu" Endif Reponse%=X%+1+Terrp& Exit if True Endif ' Case 3 If Not @Test3(B$) If Len(Terr$)=0 Terr$="ParamŠtre incorrect"+", VALEUR "+"attendu"+"e" Endif Reponse%=X%+1+Terrp& Exit if True Endif ' Case 4 If Not @Test4(B$) If Len(Terr$)=0 Terr$="ParamŠtre incorrect"+", CHAINE "+"attendu"+"e" Endif Reponse%=X%+1+Terrp& Exit if True Endif ' Case 5 If Not @Test5(B$) If Len(Terr$)=0 Terr$="ParamŠtre incorrect"+", VARIABLE "+"attendu"+"e" Endif Reponse%=X%+1+Terrp& Exit if True Endif ' Case 6 If Not @Test6(B$) If Len(Terr$)=0 Terr$="ParamŠtre incorrect"+", VARIABLE $ "+"attendu" Endif Reponse%=X%+1+Terrp& Exit if True Endif ' Case 7 If Not @Test7(B$) If Len(Terr$)=0 Terr$="ParamŠtre incorrect"+", mauvaise COULEUR" Endif Reponse%=X%+1+Terrp& Exit if True Endif ' Case 8 If Not @Test8(B$) If Len(Terr$)=0 Terr$="ParamŠtre incorrect"+", [1..63] "+"attendu" Endif Reponse%=X%+1+Terrp& Exit if True Endif ' Case 9 If Not @Test9(B$) If Len(Terr$)=0 Terr$="ParamŠtre incorrect"+", mauvais NOM" Endif Reponse%=X%+1+Terrp& Exit if True Else W%=-1 Endif ' Endselect ! instr(a,c) ' If Z%=0 ! Il faut rajouter une ',' If C%<>0 Select Mid$(A$,X%,1) Case ""," " ! Param vide! B$=","+B$ ! On ajoute une "," ! Endselect Endif Endif ' On modifie, si il y a lieu, les paramŠtres: A$=Left$(A$,X%)+B$+Mid$(A$,X%+Z%+1) ' 'Add X%,Z%+1+(Len(B$)-Z%) Add X%,Len(B$)+1 ! optimis‚! ' ' Endif ' Next C% If Len(E$)>0 If Len(Terr$)=0 Terr$="Trop de paramŠtres" Reponse%=X%+1 Endif Endif ' A$=Trim$(A$) While Right$(A$,1)="," ! une virgule en trop? A$=Left$(A$,Len(A$)-1) Wend ' ok If Reponse%=0 And W%=True Gosub Defmouse(2) Gosub Plock Gosub Defmouse(0) Endif Return Reponse% ' Endif Else A$=Trim$(A$) Return Reponse% Endif ' If Len(Terr$)=0 Terr$="Instruction "+"inconnu"+"e" Endif A$=Trim$(A$) Return 1 Endif A$=Trim$(A$) Clr Terr$,Terrp& Return 0 ' Endfunc ' ' paramx: 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc Function Test1(Var T$) $F% ' Etest!=True If Len(T$)=0 T$="ON" Return True Else Select T$ Case "ON","OFF" Return True Case "O","ONN","ACTI","1","-1","TRUE","+","IN" T$="ON" Return True Case "F","OF","DESA","DSA","D‚SA","0","FALS","-","OUT" T$="OFF" Return True Endselect Endif Return False ' Endfunc Function Test2(Var T$) $F% Local Resultat# ' Etest!=True T$=@Strform$(T$) If @Valx(True,T$,Resultat#)<>0 Return True Endif Return False ' Endfunc Function Test3(Var T$) $F% Local Resultat# ' Etest!=True T$=@Strform$(T$) If Terrp&=0 If @Valx(True,T$,Resultat#)<>0 Return True Endif Endif Return False ' Endfunc Function Test4(Var T$) $F% Local E$ ' Etest!=True T$=@Strform$(T$) If @Vals(True,T$,E$)<>0 Return True Endif Return False ' Endfunc Function Test5(Var T$) $F% Local A% ' ' If @Vvalx(T$)<>-1 Etest!=True T$=Upper$(T$) For A%=1 To Len(T$) Select Mid$(T$,A%,1) Case "A" To "Z",".","_" Case "0" To "9" If A%=$ And And And And Imp $ And + And ]=False Return False Endif Default Return False Endselect Next A% Return True Endfunc Function Test6(Var T$) $F% Local A% ' Etest!=True For A%=1 To Len(T$) Select Mid$(T$,A%,1) Case "A" To "Z",".","_" Case "0" To "9" If A%=1 Return False Endif Case "$" If Not (A%=1 Or A%=Len(T$)) Return False Endif Default Return False Endselect Next A% ' ' Type xxx$ (et non pas xxx ou $xxx ou mˆme $xxx$ !!...) If Right$(T$,1)="$" If Left$(T$,1)="$" T$=Mid$(T$,2) Endif Else if Left$(T$,1)="$" T$=Mid$(T$,2) If Right$(T$,1)<>"$" T$=T$+"$" Endif Else T$=T$+"$" Endif ' ' If @Vvals(T$)<>-1 Return True Endfunc Function Test7(Var T$) $F% ' Etest!=True If @Valcol(True,0,T$)<>-1 Return True Endif Return False Endfunc Function Test8(Var T$) $F% Local Resultat# ' Etest!=True T$=@Strform$(T$) If @Valx(True,T$,Resultat#)<>0 ' If Resultat#=>0 And Resultat#<=63 Return True ' Endif Endif Return False ' Endfunc Function Test9(Var T$) $F% $S& Local A%,B%,C%,X%,N%,Z% Local E$,A$ ' Etest!=True X%=-1 B%=0 C%=0 N%=0 ! nbr de params ' ' Filtrer A%=Instr(T$,Chr$(32))<>0 While A%>0 T$=Left$(T$,A%-1)+Mid$(T$,A%+1) A%=Instr(T$,Chr$(32))<>0 Wend If Instr(T$,"()")<>0 Mid$(T$,Instr(T$,"()"))=" " Endif T$=Trim$(Upper$(T$)) If Instr(T$,"(")<>0 If Instr(T$,")")=0 Terr$="pas de )" X%=Len(T$) Endif Endif ' A%=0 B%=0 ! flag () ouvertes C%=0 ! flag , pass‚e If Len(T$)>0 And X%=True Do $S& Select Mid$(T$,A%,1) Case "(" If B%=0 B%=-1 C%=-1 Else Terr$="( en trop" X%=0 Exit if True Endif Case ")" If B%=-1 B%=0 C%=0 Else Terr$="@ ) en trop" X%=0 Exit if True Endif ' Case "A" To "Z","0" To "9","_" ' If B%=-1 ' Terr$="@ "+"Erreur"+" de syntaxe, nom dans proc?" ' X%=0 ' Exit if True ' Endif Case "/","&","#","$","œ","A" To "Z","0" To "9",".","_" ' If B%=0 Or C%=0 If B%=-1 ' Terr$="@ Param‚tre "+"inconnu" ' X%=0 ' Exit if True ' ' Else Clr E$ Z%=A% ! Start type Do Select Mid$(T$,A%,1) Case "/","&","#","$","œ","A" To "Z","0" To "9",".","_" E$=E$+Mid$(T$,A%,1) Default ! on sort Exit if True Endselect Inc A% Loop Dec A% ! pour + tard, fin de boucle ' C%=0 Inc N% If N%>Dinstr&+1 Terr$="@ Trop de paramŠtres max=10" X%=0 Exit if True Else ' ' Print At(1,1);Mid$(T$,Z%,A%-Z%+1), $S& Select Left$(E$,2) Case "/","ON","O" A$="ON/OFF" Case ".","N6","N" A$="N63" Case "&","OC","O" A$="OCTET" Case "#","RE","R" A$="REEL" Case "$","CH","C" A$="CHAINE" Case "œ","CO" A$="COULEUR" ' Default If E$="ON/OFF" Else if E$="N63" Else if E$="OCTET" Else if E$="REEL" Else if E$="CHAINE" Else if E$="COULEUR" Else Terr$="@ ParamŠtres autoris‚s: ON/OFF N63 OCTET REEL CHAINE COULEUR" X%=0 Exit if True Endif ' Endselect $S% ' T$=Left$(T$,Z%-1)+A$+Mid$(T$,A%+1) A%=Z%+Len(A$)-1 ! Adding (ou sub hein!) Endif Endif Case "," If B%=-1 If C%=0 C%=-1 Else Terr$="@ "+"Erreur"+" de syntaxe"+" avec les ," X%=0 Exit if True Endif Else Terr$="@ "+"Erreur"+" de syntaxe"+", () non ouvertes" X%=0 Exit if True Endif ' Case " " ! hmm.. T$=Left$(T$,A%-1)+Mid$(T$,A%+1) Dec A% ' Default If B%=0 Terr$="@ CaractŠre de procedure ill‚gal" Else Terr$="@ ParamŠtres autoris‚s: ON/OFF N63 OCTET REEL CHAINE COULEUR" Endif X%=0 Exit if True Endselect $S% Inc A% Loop until A%>Len(T$) ' If C%=-1 ! encore une ',' ? If Len(Terr$)=0 Terr$="@ "+"Erreur"+" de syntaxe , en trop" X%=0 Endif Endif ' Else If Len(Terr$)=0 Terr$="@ Au moins 1 lettre!!" Endif X%=0 Endif If X%=0 Terrp&=A% Endif ' Return X% $S% Endfunc ' Function Vvalx(Var T$) $F% Local A% ' If Len(T$)=1 A%=Asc(Upper$(Left$(T$,1))) If A%=>65 And A%<=90 Return A%-64 Endif Else if Len(T$)=2 If Left$(T$,1)="#" A%=Asc(Upper$(Left$(T$,1))) If A%=>65 And A%<=90 T$=Chr$(A%) Return A%-64 Endif Endif Endif Return -1 ' Endfunc Function Vvals(Var T$) $F% Local A% ' If Len(T$)<=2 $S& Select Left$(T$,1) ' Case "$" A%=Asc(Mid$(T$,2,1)) Select A% Case "A" To "Z" Return A%-64 Case "1" To "9" T$="$"+Chr$(A%+16) Return A%-48 Endselect ' Case "A" To "Z" A%=Asc(Left$(T$,1)) If Mid$(T$,2,1)="$" Or Len(T$)=1 T$="$"+Chr$(A%) Return A%-64 Endif Endselect $S% Endif ' Return -1 ' Endfunc ' INDEX= 0TEXTE 1FOND Function Valcol(Index&,X%,Var T$) $F% Local A%,B%,A$ ' T$=Trim$(T$) For A%=0 To 1 B%=0 Do Exit if Col$(A%,B%)=T$ Inc B% Loop until B%>7 If B%<=7 T$=Col$(0,B%) Exit if True Endif Next A% If A%<>2 Return Asc(Ec$(X%,B%)) Else Clr A$ A$=Mid$(T$,5) ! suite ' $S% Select T$ Case "BLEU" ! bleuvert ou bleuE If A$="E" T$="BLEU" Return @Valcol(Index&,X%,T$) Else if A$="VERT" T$="CYAN" Return @Valcol(Index&,X%,T$) Endif Case "NOIR" If A$="E" Or Len(A$)=0 T$="NOIR" Return @Valcol(Index&,X%,T$) Endif Case "VERT" If A$="E" Or Len(A$)=0 T$="VERT" Return @Valcol(Index&,X%,T$) Endif Case "BLAN" If A$="CHE" Or Len(A$)=0 T$="BLANC" Return @Valcol(Index&,X%,T$) Endif ' Case "ROSE" T$="MAGENTA" Return @Valcol(Index&,X%,T$) Case "RO","ROS","MA","MAG" T$="MAGENTA" Return @Valcol(Index&,X%,T$) Case "BLAC" If A$="K" Or Len(A$)=0 T$="NOIR" Return @Valcol(Index&,X%,T$) Endif Case "RED" T$="ROUGE" Return @Valcol(Index&,X%,T$) Case "GREE","G" If A$="N" Or Len(A$)=0 T$="VERT" Return @Valcol(Index&,X%,T$) Endif Case "YELL","Y" If A$="OW" Or Len(A$)=0 T$="JAUNE" Return @Valcol(Index&,X%,T$) Endif Case "BLUE" T$="BLEU" Return @Valcol(Index&,X%,T$) Case "WHIT","W" T$="BLANC" Return @Valcol(Index&,X%,T$) ' ' Case "NO","NOI","@","P" T$="NOIR" Return @Valcol(Index&,X%,T$) Case "BLE","T","D" T$="BLEU" Return @Valcol(Index&,X%,T$) Case "RO","ROU","ROUG","Q","A" Select A$ Case "","E" T$="ROUGE" Return @Valcol(Index&,X%,T$) Endselect Case "MAGE" Select A$ Case "","NTA","NT","N","U","E" T$="MAGENTA" Return @Valcol(Index&,X%,T$) Endselect Case "VE","VER","B","R" T$="VERT" Return @Valcol(Index&,X%,T$) Case "CY","CYA","CYAN","F","V" If Len(A$)=0 T$="CYAN" Return @Valcol(Index&,X%,T$) Endif Case "JA","JAU","JAUN","C","S" Select A$ Case "E","" T$="JAUNE" Return @Valcol(Index&,X%,T$) Endselect Case "BLA","BLAN","G","W" T$="BLANC" Return @Valcol(Index&,X%,T$) Endselect ' Endif Terr$="Je ne connais pas cette couleur!" Return -1 ' Endfunc ' ' ' -------------------------------------------------- ' CLEAR VARS Procedure Clearv Local A% If Dim?(Procx#()) For A%=0 To 9 Procx#(A%)=0 Proc$(A%)="" Next A% Endif ' Gosub Clearvars ! Effacer vars s.g.v.e. ' Void Fre(0) Return ' ' ' =Init Procedure M_init Local P$ ' Dim Msg&(7) ' P1__&=Byte(Ror(Xbios(15,-1,-1,-1,-1,-1,-1),24)) ' If Work_out(0)<500 If @Form_alert(1,"[3][|R‚solution trop petite|pour "+Name$+"][ Annuler |Continuer]")=1 On error gosub Eop Edit Endif Endif ' ' Animation Set_mouse&=0 Dim M_anim$(5) For Boucl&=0 To 5 M_anim$(Boucl&)="" For C%=0 To 73 M_anim$(Boucl&)=M_anim$(Boucl&)+Chr$(Byte{M_anim%+C%+Boucl&*74}) Next C% Next Boucl& ' If Vopen!=False Open "O",#5,"AUX:" Vopen!=True Endif ' Dim G_s%(5),G_s2%(5),G_screen%(5),R_d%(8) ! champs BitBlT Arrayfill G_screen%(),0 ! screen=0,0,0,0.. ' Dim G_s&(9) ! pour vro_cpy_form Arrayfill G_s&(),0 ! screen=0,0,0,0.. ' Dim Stav$(50) ! Vars pour le Do..Next ' Clr Menu_adr% ! pas de menu pour le moment ' ' File$: File sans () Dim File$(8) ! noms de fichier ' 0: *.SWT File$(0)="SANS_NOM.SWT" ' 1: *.EGR File$(1)="SANS_NOM.EGR" ' 2: *.VDT File$(2)="SANS_NOM.VDT" ' 3: *.LSW File$(3)="SANS_NOM.LSW" ' 4: *.SFD File$(4)="SANS_NOM.SFD" ' 5: *.* (image) File$(5)= f  boxtext dans l'arbre proc *…ÉÈf  button dans l'arbre proc &ÉÈf  box dans l'arbre proc *~ÉÈf  string dans l'arbre proc *„ÉÈf  button dans l'arbre proc ,Asin(Sqr(Inkey$Input$(Sqr(Pi#( Downto # To ' 6: *.MCS (macros) - SUPPRIM ' File$(6)="MACROS.MCS" - SUPPRIM ' 7: *.SFC (sweety font character) File$(7)="SANS_NOM.SFC" ' 8: *.SGM (SeGMents) File$(8)= f  boxtext dans l'arbre proc *…ÉÈf  button dans l'arbre proc &ÉÈf  box dans l'arbre proc *~ÉÈf  string dans l'arbre proc *„ÉÈf  button dans l'arbre proc ,Asin(Sqr(Inkey$Input$(Sqr(Pi#(Inkey$ To # ' Gosub Errstr ! chaines erreur ' Gosub Eval_init ! Inits pour Gosub Vxinit ! l'‚valuateur! ' Dim Dovar#(15) ! Local pour Do ' ' Loupe If Lp_px&=-1 ! no predefs Lp_px&=334 Lp_px&=334 Lp_py&=Ccsizey&+6 Lp_mx&=16 Lp_my&=16 Lp_zx&=4 Lp_zy&=2 Lp_draw!=False ! drawed? Endif ' Gosub Rsrc_load ' Get_csize Gosub Getplane ! init plans ' CaractŠres initiaux Ncach&=65536/(@Bitlen(Ccsizex&,Ccsizey&)+15) Ncach&=Max(16,Ncach&) Ncach&=Min(4096,Ncach&) ' Gosub Emul_init Gosub Drcs_init Gosub Bit_init ' Gosub Rim_init ' Dim Par_p&(9) ! Params ' If Scrp_read(P$)=1 ! d‚truire fichier 1st P$=P$+"SCRAP.1ST" If @Exist(P$) P$=P$+Chr$(0) ~Gemdos(65,L:Varptr(P$)) Endif Endif ' Return ' =Uninit Procedure M_uninit Erase Msg&() ' Gosub Rsrc_free Erase Errp$(),Errn$() Erase Dovar#() Erase Stav$() ! Pour le Do..Next Erase File$() ! noms fichiers Gosub Eval_uninit ! UnInits pour Gosub Vxuninit ! l'‚valuateur! Gosub Emul_uninit Gosub Bit_uninit Erase Par_p&() ! buffer param procedures Rim_uninit ' $S& Select Left$(Set_path$,1) Case "A" To "Z" Chdrive Left$(Set_path$,1) Endselect $S% Chdir Set_path$ ' ~Xbios(15,-1,-1,P1__&,-1,-1,-1) Return Procedure Initel ' Gosub Inivars ! initialisation des variables vid‚otext ' ' 1200B vers le nitel - r‚glages st aprŠs! @Videmntl If Set_speed! Outvid(V1200b$) Else Atsend(Modem$(0)) ! init Endif Void Fre(0) ' Clr Tv$ ! pr‚sentation Sweetel Tv$=@Pos$(1,0) For A%=0 Downto -2 If A%=-1 Tv$=Tv$+Inverse$ Else if A%=-2 Tv$=Tv$+Inverseoff$ Endif Tv$=Tv$+Chr$(13)+" "+Esc$+"GS" Tv$=Tv$+Esc$+"Fw" Tv$=Tv$+Esc$+"Ee" Tv$=Tv$+Esc$+"De" Tv$=Tv$+Esc$+"Ct" Tv$=Tv$+Esc$+"Be" Tv$=Tv$+Esc$+"Al"+Bl$ Next A% Tv$=Tv$+Chr$(13)+Title$+Cls$ Void Fre(0) ' ' r‚glages st nitel If Set_speed! ! prise en compte de la vitesse? ~Xbios(15,7,0,174,-1,-1,-1) ~Evnt_timer(600) If Speed&<>0 ! vitesse diff‚rente? @Setspeed ! alors modifier! Endif Else @Setspeed Endif @Videmntl ' ' D‚sinterlacage/Interlacage (index<->couleur) ' Dim Intercol&(7),Extercol&(7) ' Intercol&(0)=0 Intercol&(1)=2 Intercol&(2)=4 Intercol&(3)=6 Intercol&(4)=1 Intercol&(5)=3 Intercol&(6)=5 Intercol&(7)=7 ' Extercol&(0)=0 Extercol&(1)=4 Extercol&(2)=1 Extercol&(3)=5 Extercol&(4)=2 Extercol&(5)=6 Extercol&(6)=3 Extercol&(7)=7 ' Return Procedure Inivars Let Rtd$=Mki$(&H2030)+Chr$(&H45)+Chr$(1)+Chr$(&HFF) ' Let Esc$=Chr$(27) ! esc Let Cls$=Chr$(12) ! cls Let Sep$=Chr$(19) ! sep Let Cr$=Chr$(13)+Chr$(10) ! cr/lf Let Cr2$=Chr$(10)+Chr$(13) ! lf/cr (inutile!!) Let Crt$=Chr$(13) ! lf Let Pro1$=Esc$+"9" ! PRO1 Let Pro2$=Esc$+":" ! PRO2 Let Pro3$=Esc$+";" ! PRO3 Let Reset$=Pro1$+Chr$(127) ! reset vid‚otex Let Text$=Chr$(15) ! mode texte Let Graph$=Chr$(14) ! mode graphique Let Beep$=Chr$(7) ! beep Let Flash$=Esc$+"H" ! flash on Let Flashoff$=Esc$+"I" ! flash off Let Tn$=Esc$+"L" ! taille normale Let Dh$=Esc$+"M" ! double hauteur Let Dl$=Esc$+"N" ! double largeur ' Let Dl$=Esc$+"N"*2 ! double largeur Let Dt$=Esc$+"O" ! double taille ' Let Dt$=Esc$+"O"*3 ! double taille Let Mask$=Esc$+"X" ! masquage ligne Let Maskend$=Esc$+"_" ! d‚masquage ligne Let Allume$=Esc$+"# _" ! allume masque Let Eteint$=Esc$+"# X" ! ‚t‚int masque Let Line$=Esc$+"Z" ! lignage on Let Lineoff$=Esc$+"Y" ! lignage off Let Inverse$=Esc$+"]" ! inverse on Let Inverseoff$=Esc$+"\" ! inverse off Let C_g$=Chr$(8) ! curseur gauche Let C_d$=Chr$(9) ! curseur droit Let C_b$=Chr$(10) ! curseur bas Let C_h$=Chr$(11) ! curseur haut Let Curson$=Chr$(17) ! cursor on Let Cursoff$=Chr$(20) ! cursor off Let Bl$=Chr$(24) ! bourrage ligne Let Whatxy$=Esc$+"a" ! ask pos Deffn Repet$(Index&)=Chr$(18)+Chr$(Index&+64) ! repetition char Deffn Pos$(X%,Y%)=Chr$(31)+Chr$(Y%+64)+Chr$(X%+64) ! posxy Deffn Transp$(X%)=Pro2$+"f"+Chr$(X%) Let Home$=Chr$(30) ! Home Let Cll$=@Pos$(1,0)+Bl$+C_b$ ! Clear line 0 Let Maj$=Pro2$+"jE" ! maj Let Min$=Pro2$+"iE" ! min Let Col40$=Pro2$+"2~" ! 40col Let Col80$=Pro2$+"2}" ! 80col fran‡ais Let Col80a$=Pro2$+"1}" ! 80col am‚ricain Let Roulon$=Pro2$+"iC" ! rouleau on Let Rouloff$=Pro2$+"jC" ! rouleau off Let Drcton$=Esc$+"( B" ! Drcs text on Let Drctoff$=Esc$+"(@" ! Drcs text off Let Drcgon$=Esc$+") C" ! Drcs graph on Let Drcgoff$=Esc$+")c" ! Drcs graph off ' Let Ldt$=Mkl$(&H1F232020)+Mki$(&H2042)+Chr$(&H49) ! Drcs text load Let Ldg$=Mkl$(&H1F232020)+Mki$(&H2043)+Chr$(&H49) ! Drcs graph load ' Let Kon$=Pro3$+"iYA" ! Fnc C+E ‚tendu Let Koff$=Pro3$+"jYA" ! Fnc C+E normal ' Let V300b$=Pro2$+Chr$(&H6B)+"R" ! vitesses 300,1200,4800,9600 bps. Let V1200b$=Pro2$+Chr$(&H6B)+"d" ! Let V4800b$=Pro2$+Chr$(&H6B)+"v" ! Let V9600b$=Pro2$+Chr$(&H6B)+Chr$(127) ' Return ' ' ' ' ' ' ' /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ ' Emulateur vid‚otex Sweetel 2.0 - ½1993 Xavier ROCHE ' /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ ' ' Note: pas mal de procedures ont leurs variables locales remplac‚es par des ' blobaux sp‚cifiques, pour ac‚l‚rer le traitement! ' ' Init ‚mul+DRCS Procedure Emul_init Local E|,W&,H& Local A$ ' If Len(Col$)=0 Gosub Set_col(0) Endif ' Dim Em$(3) ' ' "locaux" pour Vdraw!! Clr Vd_c&,Vd_a&,Vd_b&,Vd_z&,Vd_w&,Vd_h&,Vd_aff!,Vd_a&,Vd_b& Clr Vd_e1&,Vd_e2& Clr Vd_part1!,Vd_part2!,Vd_part3!,Vd_part4! Clr Vdp_w&,Vdp_h& ' Dim Vd_drm&(1,3,9) ! 0: Normal 1: Double / 0: X 1: Y 2: W 3: H / index 0..7 ou 0..9 ' ! coefficient multiplicateur pour afficher la fonte DRCS ' F_c&=38 ' Dim Spe|(5) ! 6 chars pile max Special&=0 Dim Spedr|(13) ! 14 sextets DRCS Dim Vids&(79,24) Dim Vidc&(79,24) ! fictif Dim Vida|(79,24) Dim Vidi|(79,24) ! fictif Dim Vsavet&(40) ! sauvegarde attributs, pos, etats etc en cas de pos sur ligne 0 Arrayfill Vids&(),32 ! Spc Arrayfill Vida|(),&X1000000 ! Inhibiteur pour fond XXXX For E|=0 To 39 Vidi|(E|,0)=&X1 ! LINE 0 Vidi|(E|,1)=&X10 ! LINE 1 Vida|(E|,0)=&X0 ! Non inhibiteur! Next E| Vidi|(38,0)=&X110 ! Hidden Arrayfill Vidc&(),&H700 ! txt blanc fond noir X_curs&=0 ! Pos Y_curs&=1 Ncurs!=True ! Curs activ‚ Cnext|=&HFF ! Next color -rien- Anext|=&HFF ! Next attrb -rien- Cmnext|=&HFF ! Next color (m‚moire) -rien- Amnext|=&HFF ! Next attrrb (m‚moire) -rien- Anext_t|=0 ! Next attrb type -rien- Emulm|=0 ! Vid‚otex Acurs|=0 ! Attrb: -rien- Ccurs&=&H700 ! color actuelle Tcurs|=0 ! Taille normale Vmax_x&=39 ! Taille max en vdtx Vmax_y&=24 Vmode!=False ! replace Rmode!=False ! rouleau off Dmodet!=False ! mode DRCS text? Dmodeg!=False ! mode DRCS graph? ' Dim Fcol&(7),Fstyl|(7),Findex|(7) Dim Tcol&(7,1),Tcof!(7) Dim Flasher&(7,2) ! R,G,B For E|=0 To 7 Fcol&(E|)=Min(Work_out(13),E|) Fstyl|(E|)=1 Findex|(E|)=1 Tcol&(E|,0)=Min(Work_out(13),E|) Tcol&(E|,1)=Min(Work_out(13),E|) Tcof!(E|)=False ! non flash Next E| ' A$="SWCOL"+Hex$(Work_out(13),3)+".CNF" ' If Not @Exist(A$) ' A$="\"+A$ ' Endif If @Fexist(A$) Gosub Defmouse(2) Open "I",#1,A$ Select Lof(#1) ! 8*6*2 Case 96,100 For E|=0 To 7 Fcol&(E|)=Inp&(#1) Fstyl|(E|)=Inp&(#1) Findex|(E|)=Inp&(#1) Tcol&(E|,0)=Inp&(#1) Tcol&(E|,1)=Inp&(#1) Tcof!(E|)=(Inp&(#1)<>0) Next E| Endselect If Lof(#1)=100 Efont&=Cvi(Input$(2,#1)) Vdt_tail&=Cvi(Input$(2,#1)) Endif Close #1 Gosub Defmouse(0) Endif ' A$="SWVDI"+Hex$(Work_out(13),3)+".CNF" If @Fexist(A$) Gosub Defmouse(2) Open "I",#1,A$ Col$=Input$(Lof(#1),#1) Close #1 Gosub Defmouse(0) Endif ' Get_csize Dim Etext&(4),Decalt&(4) ! table des tailles, d‚calage low line ' ' ' Input Eccsizey& If Eccsizex&*Eccsizey&=0 If Vdt_tail&>0 Contrl(0)=12 Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=Vdt_tail& Vdisys Contrl(0)=38 ! Inquire Current Graphic Text Attributes Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys Eccsizey&=Ptsout(3) Contrl(0)=117 ! Inquire Character Cell Width Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Vdisys Eccsizex&=Ptsout(0) Else Eccsizex&=Ccsizey& Eccsizey&=Ccsizey& Efont&=1 Endif If Efont&<=0 Efont&=1 Endif Endif ' W&=Eccsizex& H&=Eccsizey& If Dim?(Wopen!()) Wset_max_w(4,Eccsizex&*85) ! ‚mulateur Wset_max_h(4,Eccsizey&*30) ! If Wopen!(4) @Wsetsl(4) Endif Endif ' ' Haut,Large,Double.. Etext&(0)=@Text_size_find(W&,H&,2) Etext&(1)=@Text_size_find(W&,H&*2,2) Etext&(2)=@Text_size_find(W&*2,H&,2) Etext&(3)=@Text_size_find(W&*2,H&*2,2) Etext&(4)=@Text_size_find(W&,H&,2) Cache_init ' ' Contrl(0)=12 Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=Etext&(4) Vdisys ' Contrl(0)=38 ! Inquire Current Graphic Text Attributes Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys Vdt_tail&=Ptsout(1) ! taille fonte! Font_dec&=Ptsout(1) ! d‚calage Eccsizey&=Ptsout(3) ' Contrl(0)=117 ! Inquire Character Cell Width Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Vdisys Eccsizex&=Ptsout(0) ' Etext&(4)=Eccsizey& ! taille txt, 4=sweet ' Contrl(0)=38 Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys Arrayfill Decalt&(),Ptsout(1) ! d‚calage W&=Eccsizex& H&=Eccsizey& ' Set_text&=0 If Dim?(Wopen!()) Gosub Field_max Endif Emul!=True ! mode ‚mul ' Vd_e1&=Eccsizex&\2 Vd_e2&=Eccsizey&\3 ' Return Procedure Emul_text(N&) If Set_text&<>N& If Efont&<>Font& ! pas mˆme fonte Contrl(0)=21 ! set text face Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=Font&(Efont&) Vdisys Endif Set_text&=N& Contrl(0)=12 ! Set character height, Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=Etext&(N&) Vdisys Endif Return Procedure Sweety_text If Set_text&<>-1 ! remettre en ‚tat!! ' If Efont&<>Font& ! pas mˆme fonte Contrl(0)=21 ! set text face Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=Font&(Font&) Vdisys Endif ' Set_text&=-1 Contrl(0)=12 ! Set character height, am Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 ' Ptsin(1)=Etext&(4) Ptsin(1)=Font_tail& Vdisys ' Gosub Deftext(Col1&,0) Gosub Deftextattrb(0) Get_csize Endif Return ' Procedure Emul_uninit Gosub Set_col(False) Gosub Sweety_text Erase Em$() Erase Vids&(),Vidc&(),Vida|(),Vidi|() Erase Vsavet&() Clr Emulm|,X_curs&,Y_curs& Erase Spe|(),Spedr|() Cache_uninit Erase Fcol&(),Fstyl|(),Findex|() Erase Tcol&(),Tcof!(),Flasher&() Erase Etext&(),Decalt&() ! table des tailles, d‚calage low line Erase Vd_drm&() ' Deftext 1,0,0,Or_tail& ' Return ' Procedure Cache_init Local A&,T# ' ' ' Garde-fous: Ncach&=Max(24,Ncach&) Ncach&=Min(4096,Ncach&) ! pas trop qd mˆme!! (4 pages ca suffit!) ' Ncach&=Min((Fre(0)-Limit%)/(@Bitlen(Eccsizex&,Eccsizey&)+15),Ncach&) Ncach&=Min(Malloc(-1)/(@Bitlen(Eccsizex&,Eccsizey&)+15),Ncach&) Ncach&=Max(2,Ncach&) ' ' Dim cache$(Ncach&+1) ! Cache vid‚o ' Cachex&=Eccsizex& Cachey&=Eccsizey& Cachexx%=@Bitlen(Cachex&,Cachey&)-4 ! place Caches%=@Malloc((Ncach&+1)*Cachexx%) ' Dim Cachs&(Ncach&+1) ! Type cache Dim Cachc&(Ncach&+1) Dim Cacha|(Ncach&+1) Rovcach&=0 ! Roving Cache Pointer ' ' Cr‚er la table de distorsion pour les caractŠres DRCS: index 0,1,2,3 = X,Y,X2,Y2 T#=Eccsizex&/8 ! pas en X For A&=0 To 7 Vd_drm&(0,0,A&)=Round(T#*A&) If A&>0 Vd_drm&(0,2,A&-1)=Vd_drm&(0,0,A&)-1 Endif Next A& Vd_drm&(0,2,7)=Eccsizex&-1 ' T#=Eccsizey&/10 ! pas en X For A&=0 To 9 Vd_drm&(0,1,A&)=Round(T#*A&) If A&>0 Vd_drm&(0,3,A&-1)=Vd_drm&(0,1,A&)-1 Endif Next A& Vd_drm&(0,3,9)=Eccsizey&-1 ' ' Cr‚er la table de distorsion pour les caractŠres DRCS: index 0,1,2,3 = X,Y,X2,Y2 T#=(2*Eccsizex&)/8 ! pas en X For A&=0 To 7 Vd_drm&(1,0,A&)=Round(T#*A&) If A&>0 Vd_drm&(1,2,A&-1)=Vd_drm&(1,0,A&)-1 Endif Next A& Vd_drm&(1,2,7)=Eccsizex&-1 ' T#=(2*Eccsizey&)/10 ! pas en X For A&=0 To 9 Vd_drm&(1,1,A&)=Round(T#*A&) If A&>0 Vd_drm&(1,3,A&-1)=Vd_drm&(1,1,A&)-1 Endif Next A& Vd_drm&(1,3,9)=Eccsizey&-1 ' Drbitw&=Eccsizex& ! taille ligne If Mod(Drbitw&,16)<>0 ! pas divisible par 16? Drbitw&=(Drbitw&\16+1)*16 Endif Dim Drbit|(Drbitw&*Eccsizey&) ! "minicache" mono. pour le dessin d'un caractŠre DRCS ' Gosub Clear_cache Return Procedure Cache_uninit ' Erase cache$(),Cachs&(),Cachc&(),Cacha|() Erase Cachs&(),Cachc&(),Cacha|() ~@Mfree(Caches%) Erase Drbit|() Clr Rovcach& ' Return Procedure Clear_cache Local A& Local A% Local E$ ' Arrayfill Cachs&(),-1 ! Donn‚es annul‚es Arrayfill Cachc&(),0 Arrayfill Cacha|(),0 Arrayfill Drbit|(),0 ' ~@Mfree(Caches%) Cachex&=Eccsizex& Cachey&=Eccsizey& Cachexx%=@Bitlen(Cachex&,Cachey&)-4 ! place A%=(Ncach&+1)*Cachexx% Caches%=@Malloc(A%) ' If Caches%>0 Gosub Defmouse(2) ' *~C:Clrblk%(L:Caches%,L:A%) Gosub Defmouse(0) ' ' E$=Space$(@Bitlen(Eccsizex&,Eccsizey&)) ' For A&=0 To Ncach& ' cache$(A&)=E$ ' Next A& Else ~@Form_alert(1,"[3][|Plus de m‚moire disponible|en ‚mulation!|][Annuler]") Endif ' Clr Rovcach& Clr E$ ~Fre(0) ' Return ' Procedure Save_col Local E| ' Gosub Defmouse(2) Open "O",#1,Set_path$+"SWCOL"+Hex$(Work_out(13),3)+".CNF" For E|=0 To 7 Print #1,Mki$(Fcol&(E|)); Print #1,Mki$(Fstyl|(E|)); Print #1,Mki$(Findex|(E|)); Print #1,Mki$(Tcol&(E|,0)); Print #1,Mki$(Tcol&(E|,1)); Print #1,Mki$(Tcof!(E|)); Next E| Gosub Defmouse(0) @Showm If @Form_alert(1,"[2][|Sauver paramŠtres texte? |(type fonte+taille)][Confirmer| Non ]")=1 Gosub Defmouse(2) Print #1,Mki$(Efont&); Print #1,Mki$(Vdt_tail&); Endif Gosub Defmouse(2) Close #1 Gosub Defmouse(0) Return ' Procedure Set_col(Flag!) Local A& ' If Len(Col$)>0 If Flag! If Len(Colbak$)=0 For A&=0 To Work_out(13)-1 Contrl(0)=26 Contrl(1)=0 Contrl(3)=2 Contrl(6)=V~h Intin(0)=A& Intin(1)=0 Vdisys Colbak$=Colbak$+Mki$(Intout(1))+Mki$(Intout(2))+Mki$(Intout(3)) Next A& Endif For A&=0 To Work_out(13)-1 Contrl(0)=14 Contrl(1)=0 Contrl(3)=4 Contrl(6)=V~h Intin(0)=A& Intin(1)=Cvi(Mid$(Col$,A&*6+1,2)) Intin(2)=Cvi(Mid$(Col$,A&*6+1+2,2)) Intin(3)=Cvi(Mid$(Col$,A&*6+1+$ And And And And Eqv Or ,2)) Vdisys Next A& Else ! restore ' If Len(Colbak$)>0 For A&=0 To Work_out(13)-1 Contrl(0)=14 Contrl(1)=0 Contrl(3)=4 Contrl(6)=V~h Intin(0)=A& Intin(1)=Cvi(Mid$(Colbak$,A&*6+1,2)) Intin(2)=Cvi(Mid$(Colbak$,A&*6+$ And And And And Imp èâ&f$Space$( And And And And And Eqv And ,2)) Intin(3)=Cvi(Mid$(Colbak$,A&*6+1+4,2)) Vdisys Next A& Endif Clr Colbak$ Endif Else If Len(Colbak$)=0 For A&=0 To Work_out(13)-1 Contrl(0)=26 Contrl(1)=0 Contrl(3)=2 Contrl(6)=V~h Intin(0)=A& Intin(1)=0 Vdisys Colbak$=Colbak$+Mki$(Intout(1))+Mki$(Intout(2))+Mki$(Intout(3)) Next A& Endif Endif Return ' Procedure Clr_spe Arrayfill Spe|(),&HFF ! AŠ char suivant char sp‚cial Arrayfill Spedr|(),&HFF ! Pile DRCS ' Return Procedure Emulm(E|) Cache_uninit ' Clr Acurs|,Anext|,Cmnext| Clr Ccurs&,Cnext&,Cmnext& Vtransp!=False ! plus de transparence Emulm|=E| Select Emulm| Case 0 Vidi|(F_c&,0)=&X0 F_c&=38 Vidi|(F_c&,0)=&X110 ! Hidden Vmax_x&=39 Vmax_y&=24 Ncurs!=False ! Curs d‚sactiv‚ Case 1,2 Vidi|(F_c&,0)=&X0 F_c&=76 Vidi|(F_c&,0)=&X110 ! Hidden Vmax_x&=79 Vmax_y&=24 Ncurs!=True ! Curs activ‚ If Emulm|=1 ! Fr Vida|=Bset(Vida|,5) Endif Endselect Gosub Vcls(False) For X&=0 To Vmax_x& Vidc&(X&,0)=&H700 Vids&(X&,0)=32 Vida|(X&,0)=&X1000000 ! Inhibiteur pour fond XXXX Next X& ' Cache_init Return ' ' ' A appeller periodiquement Flag: afficher ? (sous routine) Procedure Tmanage(Flag!) Local A! Local C& Local T& ' If Bios(1,1) ! octets d‚tect‚s A!=@Tstwork(4) ! ‚mul fonctionnel? ' If Not Recept! ! de tt fa‡ons ne rien recevoir! A!=False Endif ' If Imp(Not A!,Capt|<>0) ! si pas d'‚mul, capture?! ' Lastsend|=12 ! on vient de recevoir (cf princ) ' Gosub Defmouse(2) ~@Wind_update01(1) If A! Wind_clip(4) ! clipping fenˆtre @Hidem ' @Vcurs(False) Endif Swt&=2 ~@Infow(4,"R‚ception en cours.. [SHIFT]-[SHIFT] {+[CTRL]} pour interrompre") While Bios(1,1) Inc T& ' C&=@Xinp1 C&=Inp(1) If A! Gosub Emanage(Flag!,C&) Endif If Capt|<>0 ! 1= capturer 2= fin page If C&=12 And Capt|=2 Capt|=0 Else Binair$(Captb&)=Binair$(Captb&)+Chr$(C&) If Len(Binair$(Captb&))>32000 ~@Form_alert(1,"[3][|Capture:|Bloc plein|][ Fin ]") Capt|=0 Endif Endif Endif ' If Mod(T&,16)=0 C&=@Shift $S& Select C& Case &X11 ! shift shift Gosub Defmouse(2) Gosub Videmntl ! vider Gosub Defmouse(0) Case &X111 ! shift shift crtl If @Form_alert(2,"[3][|Passer en arrˆt?|(interrompre r‚ception)|][Confirmer| Anuler ]")=1 Emul!=True ! off mode Recept!=False ! (arrˆt) Exit if True Endif Endselect $S% Endif Wend Clr Swt& Gosub Drawx(4) If A! @Lhidem ' @Vcurs(True) Gosub Deftextcol(Col1&) Gosub Deffillcol(Colg&) Gosub Color(Colg&) @Sweety_text @Showm Endif ~@Wind_update01(0) Gosub Defmouse(0) Endif ! capture ou ‚mul ' Endif Return ' ' G‚rer char C ; Flag: afficher ? Procedure Emanage(Flag!,C&) ' Local A&,X&,X%,Y&,D% ' N&,B& ?? ' Locaux remplac‚s! ' If Not Connect! ! non connect‚ If Not Set_speed! ! modem If Not Vtransp! $S& Select Em_ctc& ! dernier char Case "C" If C&=Asc("O") Em_ctc&=C& Else Clr Em_ctc& Endif Case "O" If C&=Asc("N") Em_ctc&=C& Else Clr Em_ctc& Endif Case "N" If C&=Asc("N") Em_ctc&=Asc("n") Else Clr Em_ctc& Endif Case "n" If C&=Asc("E") Em_ctc&=C& Else Clr Em_ctc& Endif Case "E" If C&=Asc("C") Em_ctc&=Asc("c") Else Clr Em_ctc& Endif Case "c" If C&=Asc("T") Em_ctc&=C& Else Clr Em_ctc& Endif Case "T" $S& Select C& Case 13,32 ! CONNECT ou CONNECT XXXXXX ' Connect!=True @Eminfo("Connexion") If Flag! Vdraw(F_c&,0) Endif ' Endselect $S% Clr Em_ctc& ' Default If C&=Asc("C") Em_ctc&=C& Else Clr Em_ctc& Endif Endselect $S% Endif Endif Endif ' Em_d!=False ! redraw all? ' M%=False ?? If Special&=0 If (Not Vtransp!) Or C&=27 $S& Select C& Case 27,31,18,19,22,25 ! Esc,Pos,Rep,Sep Special&=C& Clr_spe If C&=31 If Y_curs&<>0 ! sinon ne pas faire !!! Clr_a0 ! effacer registres de sauvegarde! Endif Endif ' Case 5 ! ENQ, demande lecture ROM If Answer! @Eminfo("Identification ROM->") If Len(Id$)>0 ' @Outvid(Chr$(1)+Id$+Chr$(4)) Print #5,Chr$(1)+Id$+Chr$(4); Endif Endif ' Case 7 ! Beep!! If Flag! @Beep Endif ' Case 8 ! Gauche Dec X_curs& If X_curs&<0 X_curs&=Vmax_x& Dec Y_curs& If Y_curs&<=0 Y_curs&=Vmax_y& Endif Endif Vdt_setme Case 9 ! Droite Inc X_curs& If X_curs&>Vmax_x& If Y_curs&<>0 And Emulm|=0 X_curs&=0 Inc Y_curs& Vdt_setme ! TV (to verify!) Else X_curs&=Vmax_x& Endif If Y_curs&>Vmax_y& ' Ycurs1 Y_curs&=@Ynewcurs(1,Flag!) ! {\ curs=1 ou scroller! If Not Btst(Acurs|,4) ! si texte! Ccurs&=And(Ccurs&,&HFF00) Endif ' 'Gosub Yc /\ ! {/ remplacent ycurs1 Endif Endif Vdt_setme Case 10 ! Bas,Lf If Y_curs&<>0 Inc Y_curs& If Y_curs&>Vmax_y& ' Ycurs1 Y_curs&=@Ynewcurs(1,Flag!) If Not Btst(Acurs|,4) ! si texte! Ccurs&=And(Ccurs&,&HFF00) Endif ' Gosub Yc /\ ! {/ remplacent ycurs1 Endif Vdt_setme Else ! Ycurs=0 donc on restaure ancienne pos!! Gosub Restore_a0 ! restaurer Endif Case 11 ! Haut If Y_curs&<>0 ! ne fonctionne pas en l0 Dec Y_curs& If Y_curs&<=0 Y_curs&=Vmax_y& Endif Vdt_setme Endif Case 12 ! Cls If Emulm|=0 Gosub Vcls(Flag!) ' If Flag! ' Gosub Vcls_draw ' em_d!=-1 ! redraw ' Endif ' Else ! 80 col ‚mulator If Y_curs&>0 ! pos >0! Inc Y_curs& If Y_curs&>Vmax_y& ' Ycurs1 Y_curs&=@Ynewcurs(1,Flag!) ' Gosub Yc ! {/ remplacent ycurs1 If Not Btst(Acurs|,4) ! si texte! Ccurs&=And(Ccurs&,&HFF00) Endif Endif Endif Endif ' Case 13 ! Cr X_curs&=0 Vdt_setme ' Case 14 ! Graphique If Emulm|=0 ' *******??? Amnext|=&HFF ! annulation d'attributs If Not Lstat! Lstat!=Btst(Acurs|,1) And (Not Btst(Acurs|,4)) Endif Acurs|=Bclr(Acurs|,1) Acurs|=Bset(Acurs|,4) Acurs|=Bclr(Acurs|,3) ! plus d'invers‚ Clr Tcurs| ! (invalide en graph) If Dmodeg! Acurs|=Bset(Acurs|,7) ! DRCS Else Acurs|=Bclr(Acurs|,7) ! TEXT Endif If Cmnext|<>&HFF ! mˆme en pos, <>$ff (=0) Cnext|=Cmnext| ! ‚xecuter, par exemple sur une ligne bleue Endif If Amnext|<>&HFF ! mˆme en pos, <>$ff (=0) Anext|=Amnext| Endif If Cnext|<>&HFF Ccurs&=(And(Ccurs&,&HFF00) Or Cnext|) ! oui, ex: FOND BLEU+GRAPH -> chger de fond aussi Cnext|=&HFF Endif Else Acurs|=Bset(Acurs|,5) ! non ansi Endif Case 15 ! Texte If Emulm|=0 ' ********??? Amnext|=&HFF ! annulation d'attributs If Not Lstat! Lstat!=Btst(Acurs|,1) And (Not Btst(Acurs|,4)) Endif Acurs|=Bclr(Acurs|,1) Acurs|=Bclr(Acurs|,4) Acurs|=Bclr(Acurs|,3) ! plus d'invers‚ Clr Tcurs| ! (reset) If Dmodet! Acurs|=Bset(Acurs|,7) ! DRCS Else Acurs|=Bclr(Acurs|,7) ! TEXT Endif ' ' On ne doit normalement pas toucher au fond, mais on force une d‚claration pour placer un ' starter color, ainsi si une sur une ligne il y a 5 car en GRAPH et 5 en texte juste apres, si ' on se place au debut, mode texte, fond bleu, puis que l'on fait des espaces, il ne se passe rien ' jusqu'a la position 5 ou la propagation se met en route! Ouf!! Cnext|=Byte(Ccurs&) Else Acurs|=Bclr(Acurs|,5) ! ANSI Endif ' Case 17 ! Curs on If Emulm|=0 @Vcurs(False) Ncurs!=True @Vcurs(True) Endif Case 20 ! Curs off If Emulm|=0 @Vcurs(False) Ncurs!=False Endif ' Case 24 ! Bourrage ligne If Emulm|=0 ' On ne bouge pas! Gosub Bl(Flag!) Endif ' Case 30 ! Home, Sweet home (...) If Emulm|=0 X_curs&=0 Y_curs&=1 ' Ycurs1 Clr Tcurs| Acurs|=And(Acurs|,128) Anext|=&HFF Cnext|=&HFF Amnext|=&HFF ! celui ci est inhib‚! ' Cmnext|=&HFF ! non! Cmnext|=0 ! fond noir Ccurs&=&H700 Vdt_setme ! TV (to verify) Endif ' ' 31=POS (cf plus bas) ' Case 32 ! espace If Lstat! If Btst(Acurs|,4) ! graphique Acurs|=Bclr(Acurs|,1) Else Acurs|=Bset(Acurs|,1) Endif Lstat!=False Endif ' If Emulm|=0 If Not Btst(Acurs|,4) ! texte ' Gosub Ecatest(X_curs&,Y_curs&) ! tester si couleur 1 caractŠre avant doit diffuser.. (ou attrb) ' If Anext|<>&HFF ! on a un attribut a traiter If Cnext|=&HFF ! mais pas de couleur If Cmnext|<>&HFF ! couleur en m‚moire? Cnext|=Cmnext| ! alors traiter aussi! Else Cnext|=0 ! couleur 0 Endif Endif ' Endif ' If Cnext|<>&HFF ! Next col fond Em_x&=X_curs& ! sauver position Em_y&=Y_curs& Ccurs&=(And(Ccurs&,&HFF00) Or Cnext|) Acurs|=Bset(Acurs|,5) If Anext|=&HFF ! pas de attr. d‚clar‚ If Amnext|<>&HFF ! couleur en m‚moire? Anext|=Amnext| ! noter! Clr Anext_t| ! euh oui? Anext_t|=Bset(Anext_t|,1) ! … ‚x‚cuter APRES un chr32! eh oui!! Acurs|=Bclr(Acurs|,1) ! pour l'instant plus de lignage Endif Endif Endif ' If Anext|<>&HFF Em_x&=Xor(Acurs|,Anext|) ! confronter les 2 -> bits activ‚s=changer Acurs|=Bset(Acurs|,5) ! starter aussi! ' If Btst(Em_x&,1) ! lignage If Not Btst(Anext_t|,1) ! avant Acurs|=Bchg(Acurs|,1) ! bah oui, rep‚r‚ avec le xor, donc inverser! Em_x&=Bclr(Em_x&,1) ' 'Acurs|=Bset(Acurs|,5) ! staring block!! deja fait Endif Endif ' If Em_x&=0 Anext|=&HFF Anext_t|=0 Endif ' Endif ' Else ! graphique, aussi ' If Cnext|<>&HFF ! Next col fond Em_x&=X_curs& ! sauver position Em_y&=Y_curs& Ccurs&=(And(Ccurs&,&HFF00) Or Cnext|) ' Acurs|=Bset(Acurs|,5) Endif ' Endif ' Echar(X_curs&,Y_curs&,C&,Flag!) ! traiter char! ' Bah oui aprŠs E-char/E-fix ' If Cnext|<>&HFF ! Next col fond ' If Not Btst(Acurs|,4) ! texte NAN ? Acurs|=Bclr(Acurs|,5) ' Vida|(Em_x&,Em_y&)=Bset(Vida|(Em_x&,Em_y&),5) ! start controle color ' Endif Cnext|=&HFF Endif ' If Anext|<>&HFF If Btst(Em_x&,1) ! lignage If Btst(Anext_t|,1) ! aprŠs Acurs|=Bchg(Acurs|,1) ! bah oui, rep‚r‚ avec le xor, donc inverser! Em_x&=Bclr(Em_x&,1) ' 'Acurs|=Bset(Acurs|,5) ! staring block!! Endif ' (Acurs|=Bset(Acurs|,5) ! staring block!! pour les ? NAN! Endif ' ' If Em_x&=0 Anext|=&HFF Anext_t|=0 ' Endif Endif ' Else Echar(X_curs&,Y_curs&,C&,Flag!) ! 80col, rap! Endif ' Case 33 To ! caractŠres normaux! If Emulm|=0 If Lstat! If Btst(Acurs|,4) ! graphique Acurs|=Bclr(Acurs|,1) Else Acurs|=Bset(Acurs|,1) Endif Lstat!=False Endif ' Gosub Ecatest(X_curs&,Y_curs&) ! tester si couleur 1 caractŠre avant doit diffuser.. (ou attrb) ' If Cnext|<>&HFF ! Next col fond If Btst(Acurs|,4) ! graphique Ccurs&=(And(Ccurs&,&HFF00) Or Cnext|) Endif Endif ' Echar(X_curs&,Y_curs&,C&,Flag!) ' If Cnext|<>&HFF ! annuler If Btst(Acurs|,4) ! graphique Cnext|=&HFF ! annuler Endif Endif ' Else ! 80col If C&<127 ! 127 interdit Echar(X_curs&,Y_curs&,C&,Flag!) Endif Endif ' Case 0 ! on ne fait rien! ' Endselect $S% Endif ! si pas transparent! ' ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Else ! char sp‚ciaux : Special|<>0 ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' If C&=27 And Em_a&<>&HFF Special&=C& Clr_spe ' Clr Em_a& ! inutile Endif ' ' Inactifs si 80col \/\/\/ If Special&=&HFF ! TRAnsp Em_a&=&HFF Else if Special&=&HFE ! T‚l‚chargement DRCS Em_a&=&HFE ' Cf + loin Else ' Em_a&=5 While Spe|(Em_a&)=&HFF And Em_a&>0 ! bah oui $FF pour un 7 bit c dur... Dec Em_a& Wend If Not (Spe|(Em_a&)=&HFF And Em_a&=0) Inc Em_a& Endif Endif ' If C&=31 ! POS ' y a-t-il un chr 31 qui soit = … un POS ? If Em_a&<>&HFE And Em_a&<>&HFF ! non en DRCS t‚l Special&=C& Clr_spe ! on annule alors Clr Em_a& Endif Endif ' If Em_a&=&HFF Dec Spe|(0) If Spe|(0)<=0 ! Transp finie Clr Special&,Em_a& Endif ' ' ---- Else if Em_a&=&HFE ! DRCS t‚l ' ---- ' If Spe|(2)=&HFF ! On ne t‚l‚charge pas de char! Select C& Case &H1F ! Avis d'envoi de char Keep_a0(True) ! sauver la pile si ca doit ˆtre un POS! ' print "Demande de transmission/fin" Spe|(2)=100 ! 1er char de demande Case &H30 ! Continuer le t‚l‚char sur prochain char. Spe|(2)=0 ! GO! Spe|(1)=Spe|(1)+1 ! Next Arrayfill Spedr|(),0 ! Buff vide pour l'instant If Spe|(1)>93 ! Error, fin de tlc Eminfo("Erreur EOt‚l:"+Str$(Spe|(1))) Clr Special& ! \ Spe|(0)=&HFF ! / Spe|(1)=&HFF Spe|(2)=&HFF Endif ' Endselect ' Else if Spe|(2)<14 ! On t‚l‚charge le sextet Spe|(2)+1 ' If C&=&H1F Keep_a0(True) ! sauver la pile si ca doit ˆtre un POS! Spe|(2)=&HFF ! EOT‚l Else if C&=&H30 ! Next char! Spe|(2)=&HFF ! EoT‚l, next char Else ' print "transmission nø"+Str$(Spe|(2)+1) Spedr|(Spe|(2))=C& ! Noter char Inc Spe|(2) If Spe|(2)=>14 ! Fin tlc Spe|(2)=&HFF ! EOT‚l Endif Endif ' ' Transcription! If Spe|(2)=&HFF ! EOT‚l? ' ' print "Fin de transmission char" ' Doit-on transf‚rer vers DRCS-EDITOR? ' If Drcs! ! Yeah! great! ' If Spe|(0)=0 ' Eminfo("Transfert du '"+Chr$(Spe|(1)+33)+"' textuel") ' Else ' Eminfo("Transfert du '"+Chr$(Spe|(1)+33)+"' graphique") ' Endif ' Else ' If Spe|(0)=0 ' Eminfo("CaractŠre DRCS '"+Chr$(Spe|(1)+33)+"' textuel") ' Else ' Eminfo("CaractŠre DRCS '"+Chr$(Spe|(1)+33)+"' graphique") ' Endif ' Endif ' ' Type + Id + 14 sextets - Si Drcs! alors transfert aussi vers editeur Gosub Drs_tra(Spe|(0),Spe|(1),Spedr|(0),Spedr|(1),Spedr|(2),Spedr|(3),Spedr|(4),Spedr|(5),Spedr|(6),Spedr|(7),Spedr|(8),Spedr|(9),Spedr|(10),Spedr|(11),Spedr|(12),Spedr|(13)) If Flag! If Emulm|=0 If Afdrc! Gosub Vdt_reac(Spe|(0),Spe|(1),Flag!) Endif Endif Endif ' ' Endif ' If C&=&H30 ! Next char! Spe|(1)=Spe|(1)+1 ! Next Spe|(2)=0 ! StOT‚l Arrayfill Spedr|(),0 ! Buff vide pour l'instant If Spe|(1)>93 ! Error, fin de tlc ' Eminfo("* T‚l‚chargement achev‚") ' print "error eot‚l2:"+Str$(Spe|(1)) Clr Special& ! \ Spe|(0)=&HFF ! / indissociables! Spe|(1)=&HFF Spe|(2)=&HFF Endif Else if C&=&H1F ! $1F! Spe|(1)=&HFF Spe|(2)=100 ! on va en aprŠs 1F Else ' Spe|(1)=&HFF ! eh non on peuit recevoir un $30!! Spe|(2)=&HFF ! on continue! (d‚but) Endif ' Endif ' ' Else ! On es dans une seq ' 100: aprŠs $1F, 101: aprŠs 23, 102: aprŠs c -> 00 Select Spe|(2) Case 100 ' print "Demande de transmission 2/4 ou fin" If C&=&H23 ! Suivant 3/4 Spe|(2)=101 Else ! Sortie, traiter comme un POS! ' Gosub Clr_spe Special&=31 ! Noter commande Spe|(0)=C& ! Et 1er argument Em_a&=-2 ! run param! (cd … la fin) ' ' ' Else if C&=&H41 ! D‚but de demande de fin de t‚l ' Spe|(2)=201 ' ' Eminfo("Erreur de protocole DRCS nø1/"+Str$(C&)) ' print "error transmitt2:"+Str$(C&) Endif Case 101 ' print "Demande de transmission 3/4" C&=C&-33 If C&=>0 And C&<=93 ! Ok? Spe|(2)=102 Spe|(1)=C& ! ID du char! Else ' Gƒƒƒƒrgl! Eminfo("Erreur de protocole DRCS, trop grand/"+Str$(C&)) ' print "error char trop >:"+Str$(C&) Endif Case 102 ' print "Demande de transmission 4/4" If C&=&H30 Spe|(2)=&H0 ! GO! Arrayfill Spedr|(),0 ! Bufgf vide pour l'instant Else ' GnŒŒ.. Eminfo("Erreur de protocole DRCS nø2/"+Str$(C&)) ' print "error transmitt:"+Str$(C&) Endif ' ' Case 201 ' print "Demande de fin de transmission" ' If C&=&H42 ! FIN DE TEL! ' Special&=0 ' Gosub Clr_spe ' Else ' ???? ' Eminfo("Erreur de protocole DRCS nø3/"+Str$(C&)) ' print "error fin transmitt:"+Str$(C&) ' Endif ' Endselect ' Endif ' If Special&=&HFE ! on cont tjs? Em_a&=-1 ! cont! Else if Em_a&<>-2 ! on ne lance pas une commande? Em_a&=0 ! alors stop! Endif ' ' ---- Else if Em_a&=>6 ! Error trop de params! ' ---- ' @Eminfo("Commande inconnue (interrompue) seg #1") Clr Special& ' ' Else ! s‚qence normale … traiter ' ' Spe|(Em_a&)=C& ! Noter char ' Select Em_a& ! nbr de params ' ------------------------------ Case 0 ! 1 paramŠtre pour l'instant ' ------------------------------ ' Select Special& Case 22,25 ! Accents (22=25!) ' If Emulm|=0 ! vid‚otexte! ' C&=-1 ! pas de char valide Select Spe|(0) Case "z" C&=Asc("´") Case "j" C&=Asc("µ") Case "'" C&=Asc("Ý") Case "#" C&=Asc("œ") Case "<" C&=Asc("¬") Case "=" C&=Asc("«") Case ">" C&=Asc("þ") Case "." C&=Asc("¯") Case "," C&=Asc("®") Case "{" C&=Asc("ž") Case "1" C&=Asc("ñ") Case "8" C&=Asc("ö") Case "0" C&=Asc("ø") ' Case "A","B","C","H","K" ! suivants Em_a&=-1 Endselect ' Endif ' ' Traiter comme un caracrŠre normal If C&>0 If Not Vtransp! Echar(X_curs&,Y_curs&,C&,Flag!) Endif Endif ' ' Case 27 ! Esc? (1 paramŠtre) ' Select Spe|(0) Case "c" Gosub Vcls(Flag!) ' ' ' Case "[" ! CSI Clr Csi$ ! paramŠtres CSI Em_a&=-1 ! cont Case "@" To "G" ! Coul text If Not Vtransp! If Emulm|=0 Ccurs&=And(Ccurs&,&HFF) Ccurs&=Or(Ccurs&,(Spe|(Em_a&)-64)*&H100) Endif Endif Case "P" To "W" ! Coul fond If Not Vtransp! If Emulm|=0 ! Mode vid‚otex ' ' Note: En graphique n'importe quel caractŠre d‚clare la couleurd de fond ' If Btst(Acurs|,4) ! graphique Ccurs&=Or(And(Ccurs&,&HFF00),(Spe|(Em_a&)-80)) Endif ' Else ! texte Cnext|=Spe|(Em_a&)-80 Cmnext|=Spe|(Em_a&)-80 ! en m‚moire, en cas de LINE On par exemple, on devra ' ! remettre cette couleur de fond en mˆme temps!! ' ' mais c'est aussi le cas si on fait un GRAPH ON, sur une ligne bleue par exemple! ' ' Endif Endif Endif Case "H" ! Clignotement If Not Vtransp! If Emulm|=0 ! Mode vid‚otex Acurs|=Bset(Acurs|,0) Endif Endif Case "I" ! Non clignotant If Not Vtransp! If Emulm|=0 ! Mode vid‚otex Acurs|=Bclr(Acurs|,0) Endif Endif Case "L" If Not Vtransp! If Emulm|=0 ! Mode vid‚otex If Btst(Acurs|,4)=False ! Not graphique Tcurs|=0 ! normal Endif Endif Endif Case "M" If Not Vtransp! If Emulm|=0 ! Mode vid‚otex If Y_curs&>1 If Btst(Acurs|,4)=False ! Not graphique Tcurs|=1 ! high Endif Endif Endif Endif Case "N" If Not Vtransp! If Emulm|=0 ! Mode vid‚otex If Btst(Acurs|,4)=False ! Not graphique Tcurs|=2 ! large Endif Endif Endif Case "O" If Not Vtransp! If Emulm|=0 ! Mode vid‚otex If Y_curs&>1 If Btst(Acurs|,4)=False ! Not graphique Tcurs|=3 ! double Endif Endif Endif Endif Case "X" ! Masquage on **NON GERE** If Not Vtransp! If Emulm|=0 ! Mode vid‚otex Acurs|=Bset(Acurs|,2) Endif Endif Case "_" ! Masquage off **NON GERE** If Not Vtransp! If Emulm|=0 ! Mode vid‚otex Acurs|=Bclr(Acurs|,2) Endif Endif Case "Z" ! soulign‚ If Not Vtransp! If Emulm|=0 ! Mode vid‚otex If Not Btst(Acurs|,4) ! texte ' Acurs|=Bset(Acurs|,1) If Anext|=&HFF ! initialiser Anext|=Acurs| ! autres attributs normaux Anext_t|=0 Endif If Amnext|=&HFF ! initialiser en m‚moire Clr Amnext| Endif Anext|=Bset(Anext|,1) ! soulign‚ Anext_t|=Bset(Anext_t|,1) ! … ‚x‚cuter APRES un chr32! ' Amnext|=Bset(Anext|,1) ! soulign‚ Else ! mosa‹que Acurs|=Bset(Acurs|,1) Endif Endif Endif Case "Y" ! fin soulign‚ If Not Vtransp! If Emulm|=0 ! Mode vid‚otex If Not Btst(Acurs|,4) ! texte ' Acurs|=Bclr(Acurs|,1) If Anext|=&HFF Anext|=Acurs| ! autres attributs normaux Anext_t|=0 Endif If Amnext|=&HFF ! initialiser en m‚moire Clr Amnext| Endif Anext|=Bclr(Anext|,1) ! non soulign‚ Anext_t|=Bclr(Anext_t|,1) ! … ‚x‚cuter AVANT un chr32! ' Amnext|=Bclr(Anext|,1) ! soulign‚ Else ! mosa‹que Acurs|=Bclr(Acurs|,1) Endif Endif Endif Case "]" ! Invers‚ vid‚o If Not Vtransp! If Emulm|=0 ! Mode vid‚otex Acurs|=Bset(Acurs|,3) Endif Endif Case "\" ! Vid‚o normale If Not Vtransp! If Emulm|=0 ! Mode vid‚otex Acurs|=Bclr(Acurs|,3) Endif Endif ' Case &H61 ! position curseur If Not Vtransp! If Emulm|=0 @Eminfo("Demande de position curseur") If Answer! ' Outvid(@Pos$(X_curs&,Y_curs&)) ! alors renvoyer!! Print #5,@Pos$(X_curs&,Y_curs&); ! alors renvoyer!! Endif Endif Endif ' Case "#" ! Masque/d‚masque If Emulm|=0 Em_a&=-1 Endif ' Case "%" ! Mode transparence If Emulm|=0 Em_a&=-1 Endif ' Case "/" ! Fin mode transparence If Emulm|=0 Em_a&=-1 Endif ' Case " " ! invitation … num‚roter Em_a&=-1 ' Case "!" ! infos tarification Em_a&=-1 ' Case 34 ! " ??? Em_a&=-1 ' Case &H39,&H3A,&H3B ! Pro-1,2,3 Em_a&=-1 ' Case &H28,&H29 ! DRCS conf Em_a&=-1 ' Case "5","6" ! ??? ex: esc+6O ou esc+5M Em_a&=-1 ' Default Clr Special& ' a&=-1 Endselect ' Case 18 ! Rep If Emulm|=0 ! Mode vid‚otex If Spe|(0)-64>0 C&=Lastc| ' ' ------------------------------ copie de case 32 ------------------------------ If Lstat! If Btst(Acurs|,4) ! graphique Acurs|=Bclr(Acurs|,1) Else Acurs|=Bset(Acurs|,1) Endif Lstat!=False Endif ' If Not Btst(Acurs|,4) ! texte ' Gosub Ecatest(X_curs&,Y_curs&) ! tester si couleur 1 caractŠre avant doit diffuser.. (ou attrb) ' If Anext|<>&HFF ! on a un attribut a traiter If Cnext|=&HFF ! mais pas de couleur If Cmnext|<>&HFF ! couleur en m‚moire? Cnext|=Cmnext| ! alors traiter aussi! Else Cnext|=0 ! couleur 0 Endif Endif ' Endif ' If Cnext|<>&HFF ! Next col fond Em_x&=X_curs& ! sauver position Em_y&=Y_curs& Ccurs&=(And(Ccurs&,&HFF00) Or Cnext|) Acurs|=Bset(Acurs|,5) If Anext|=&HFF ! pas de couleur d‚clar‚e If Amnext|<>&HFF ! couleur en m‚moire? Anext|=Amnext| ! noter! Clr Anext_t| ! euh oui? Anext_t|=Bset(Anext_t|,1) ! … ‚x‚cuter APRES un chr32! eh oui!! Acurs|=Bclr(Acurs|,1) ! pour l'instant plus de lignage Endif Endif Endif ' If Anext|<>&HFF Em_x&=Xor(Acurs|,Anext|) ! confronter les 2 -> bits activ‚s=changer Acurs|=Bset(Acurs|,5) ! starter aussi! ' If Btst(Em_x&,1) ! lignage If Not Btst(Anext_t|,1) ! avant Acurs|=Bchg(Acurs|,1) ! bah oui, rep‚r‚ avec le xor, donc inverser! Em_x&=Bclr(Em_x&,1) ' 'Acurs|=Bset(Acurs|,5) ! staring block!! deja fait Endif Endif ' If Em_x&=0 Anext|=&HFF Anext_t|=0 Endif ' Endif ' Else ! graphique, aussi ' If Cnext|<>&HFF ! Next col fond Em_x&=X_curs& ! sauver position Em_y&=Y_curs& Ccurs&=(And(Ccurs&,&HFF00) Or Cnext|) ' Acurs|=Bset(Acurs|,5) Endif ' Endif ' Echar(X_curs&,Y_curs&,C&,Flag!) ! traiter char! ' Bah oui aprŠs E-char/E-fix ' If Cnext|<>&HFF ! Next col fond ' If Not Btst(Acurs|,4) ! texte NAN ? Acurs|=Bclr(Acurs|,5) ' Vida|(Em_x&,Em_y&)=Bset(Vida|(Em_x&,Em_y&),5) ! start controle color ' Endif Cnext|=&HFF Endif ' If Anext|<>&HFF If Btst(Em_x&,1) ! lignage If Btst(Anext_t|,1) ! aprŠs Acurs|=Bchg(Acurs|,1) ! bah oui, rep‚r‚ avec le xor, donc inverser! Em_x&=Bclr(Em_x&,1) ' 'Acurs|=Bset(Acurs|,5) ! staring block!! Endif ' (Acurs|=Bset(Acurs|,5) ! staring block!! pour les ? NAN! Endif ' ' If Em_x&=0 Anext|=&HFF Anext_t|=0 ' Endif Endif ' ------------------------------ fin copie de case 32 ------------------------------ ' ' If Spe|(0)-64>1 For Em_x%=1 To Spe|(0)-64-1 Echar(X_curs&,Y_curs&,C&,Flag!) Next Em_x% Endif Endif Endif ' Case 19 ! Sep If Not Vtransp! Select Spe|(0) Case "^" ! 40 col Gosub Emulm(0) Em_d!=-1 ! redraw Case "S" Connect!=Not Connect! If Connect! @Eminfo("Connexion") Else @Eminfo("D‚connexion") Endif If Flag! Vdraw(F_c&,0) Endif Case "P" ! chg vitesse cnx @Eminfo("Changement vitesse modem … la connexion") Case "Q" ! ' ' en cours @Eminfo("Changement vitesse modem en cours de connexion") Case "V" ! ack mode @Eminfo("Ack changement de mode") Case "W" ! transp @Eminfo("Ack transparence") Case "X" ! deb/fin retournement @Eminfo("D‚but/fin retournement") Case "T" ! ? Case "\" ! copie ‚cran @Eminfo("Copie ‚cran sur imprimante") ' If Answer! If False If Not Set_send! ! on nous fait pas marcher? If Gemdos(17) If @Form_alert(1,"[3][|Imprimer page minitel? |][Confirmer| Annuler ]")=1 Gosub Defmouse(2) Do If Bios(1,1) Em_x%=@Xinp1 If Em_x%=25 If Not Bios(1,1) @Pause(10) Endif If Bios(1,1) Em_x%=@Xinp1 Exit if Em_x%=Asc("\") Endif Clr Em_x% Endif If Em_x%>0 Lprint(Chr$(Em_x%)) Endif Endif If @Shiftbrk Or Inp?(2) Exit if @Form_alert(1,"[2][|Interrompre impression?|][Confirmer| Annuler ]")=1 Endif Loop Gosub Defmouse(0) Else ~@Form_alert(1,@Errf$(-9)) Endif Endif Endif Endif ' Endselect Endif ' Default ! Char avec ces param non d‚tect‚ Em_a&=-1 Endselect ' ' ------------------------------ Case 1 ! car sp‚cial + 2 params ' ------------------------------ ' If Special&=31 ' Select Rol(Spe|(0),8)+Spe|(1) Case &H2320 ! D‚but de demande t‚l DRCS!! Em_a&=-1 ! continuer! ' Default ! pos! CHR 31 + YX @Vcurs(False) ' ' X_curs&=Min(Max(0,And(Spe|(1)-65,&X111111)),Vmax_x&) ' Y_curs&=Min(Max(0,And(Spe|(0)-64,&X111111)),Vmax_y&) ' POS AB If Spe|(1)=>65 And Spe|(0)=>64 If Spe|(1)-65<=Vmax_x& And Spe|(0)-64<=Vmax_y& If Spe|(0)-64=0 If Y_curs&<>0 ! sinon ne pas faire Gosub Keep_a0(False) ! sauver tout attributs, pos, status etc etc etc Endif Endif If (Emulm|=0 Or Spe|(0)-64=0) X_curs&=Spe|(1)-65 Y_curs&=Spe|(0)-64 Endif Endif ' ' POS 12 (12Š ligne) (sisi!!) Else if Spe|(1)=>48 And Spe|(0)=>48 If Spe|(1)<=57 And Spe|(0)<=57 If (Spe|(0)-48)*10+Spe|(1)-48<=Vmax_y& If Val(Str$((Spe|(0)-48)*10+Spe|(1)-48))=0 If Y_curs&<>0 ! sinon ne pas faire Gosub Keep_a0(False) ! sauver tout attributs, pos, status etc etc etc Endif Endif If (Emulm|=0 Or Val(Str$((Spe|(0)-48)*10+Spe|(1)-48))=0) X_curs&=0 ' 'Y_curs&=Val(Chr$(Spe|(0))+Chr$(Spe|(1))) Y_curs&=Val(Str$((Spe|(0)-48)*10+Spe|(1)-48)) Endif Endif Endif Else if Spe|(0)=&H23 ! reprise de t‚l‚chargement? Em_a&=-1 ! continuer Else Spe|(0)=&HFF ! Mauvais POS Endif ' If Spe|(0)<>&HFF And Em_a&<>-1 Clr Tcurs| Acurs|=And(Acurs|,128) Anext|=&HFF Cnext|=&HFF Amnext|=&HFF ! celui ci est inhib‚! ' Cmnext|=&HFF ! non! Cmnext|=0 ! fond noir Ccurs&=&H700 Vdt_setme ! TV (to verify) Endif Endselect ' Else if Special&=25 Or Special&=22 ! Accents! ' C&=-1 ! pas de char valide Select Rol(Spe|(0),8)+Spe|(1) Case "Be" C&=Asc("‚") Case "Aa" C&=Asc("…") Case "Ae" C&=Asc("Š") Case "Au" C&=Asc("—") Case "Ha" C&=Asc("„") Case "He" C&=Asc("‰") Case "Hi" C&=Asc("‹") Case "Ho" C&=Asc("”") Case "Hu" C&=Asc("š") Case "Ca" C&=Asc("ƒ") Case "Ce" C&=Asc("ˆ") Case "Ci" C&=Asc("Œ") Case "Co" C&=Asc("“") Case "Cu" C&=Asc("–") Case "Kc" C&=Asc("‡") Endselect ' ' Traiter comme un caracrŠre normal If C&>0 Echar(X_curs&,Y_curs&,C&,Flag!) Endif ' Else if Special&=27 ' $S% Select Rol(Spe|(0),8)+Spe|(1) ' ' -------------------- $1b5b csi-------------------- ' Case &H5B42 ! Csi B Bas ' If Not Vtransp! ' If Y_curs&>0 ! Non line0 ' Inc Y_curs& ' If Y_curs&>Vmax_y& ' Y_curs&=Vmax_y& ' Endif ' Anext|=&HFF ' Cnext|=&HFF ' Vdt_setme ' Endif ' Endif ' Case &H5B41 ! Csi A hAut ' If Not Vtransp! ' If Y_curs&>0 ! Non line0 ' Dec Y_curs& ' If Y_curs&<1 ' Y_curs&=1 ' Endif ' Anext|=&HFF ' Cnext|=&HFF ' Vdt_setme ' Endif ' Endif ' Case &H5B44 ! Csi D gauche ' If Not Vtransp! ' If Y_curs&>0 ! Non line0 ' Dec X_curs& ' If X_curs&<0 ' X_curs&=0 ' Endif ' Anext|=&HFF ' Cnext|=&HFF ' Vdt_setme ' Endif ' Endif ' Case &H5B43 ! Csi C droite ' If Not Vtransp! ' If Y_curs&>0 ! Non line0 ' Inc X_curs& ' If X_curs&>Vmax_x& ' X_curs&=Vmax_x& ' Endif ' Anext|=&HFF ' Cnext|=&HFF ' Vdt_setme ' Endif ' Endif ' Case &H5B4D ! M, delete one line at current position ' If Not Vtransp! ' Gosub Delline(X_curs&,Y_curs&,1,Flag!) ' X_curs&=0 ' Endif ' Case &H5B4C ! L, insert one line at curent position ' If Not Vtransp! ' Gosub Insline(X_curs&,Y_curs&,1,Flag!) ' X_curs&=0 ' Endif ' Case &H5B50 ! P, delete one character at current XY position ' If Not Vtransp! ' Gosub Delchar(X_curs&,Y_curs&,1,Flag!) ' Endif ' ------------------------------ ' Case &H2840 ! DRCS text off If Not Vtransp! If Emulm|=0 Dmodet!=False If Not Btst(Acurs|,4) ! Justement, mode texte! Acurs|=Bclr(Acurs|,7) ! TEXTE Endif Endif Endif Case &H2963 ! DRCS graph off If Not Vtransp! If Emulm|=0 Dmodeg!=False If Btst(Acurs|,4) ! Justement, mode graph! Acurs|=Bclr(Acurs|,7) ! TEXTE Endif Endif Endif ' ------------------------------ ' Case &H5B32 ! Cls ' Case &H5B ' ' ' Note: ce ne sont pas des commandes de status mais actives, donc RAP (sauf si..) ' ----------Pro1 1B39 commandes 67-7F---------- Case &H3967 ! d‚connexion If Not Vtransp! Connect!=Not Connect! If Connect! @Eminfo("Connexion->") Else @Eminfo("D‚connexion->") Endif If Flag! Vdraw(F_c&,0) Endif Endif Case &H3968 ! connexion If Not Vtransp! @Eminfo("D‚connexion->") Connect!=False If Flag! Vdraw(F_c&,0) Endif Endif Case &H396C ! retournement If Not Vtransp! @Eminfo("Retournement modem->") Endif Case &H396D ! ret inverse If Not Vtransp! @Eminfo("Retournement modem inverse->") Endif Case &H396E ! acq retournement If Not Vtransp! @Eminfo("Ack retournement modem->") Endif Case &H396F ! mode maitre If Not Vtransp! @Eminfo("Mode maitre-") Endif Case &H3970 ! status terminal If Not Vtransp! @Eminfo("Demande status terminal->") Gosub Rep_term Endif Case &H3972 ! status fonctionnement If Not Vtransp! @Eminfo("Demande status fonctionnement->") Gosub Rep_fonct Endif Case &H3974 ! status vitesse If Not Vtransp! @Eminfo("Demande status vitesse->") Gosub Rep_vit Endif Case &H3976 ! status protocole If Not Vtransp! @Eminfo("Demande status protocole->") Gosub Rep_protoc Endif Case &H3978 ! t‚l‚charger ram1 If Not Vtransp! @Eminfo("Demande t‚l‚chargement RAM #1 ->") Endif Case &H3979 ! ram2 If Not Vtransp! @Eminfo("Demande t‚l‚chargement RAM #2 ->") Endif Case &H397A ! id ram1 If Not Vtransp! @Eminfo("Demande identification RAM #1 ->") Endif Case &H397B ! id terminal If Not Vtransp! @Eminfo("Demande identification terminal ->") Gosub Rep_id Endif Case &H397F ! ReSet vid‚otex @Eminfo("Reset vid‚otex ->") If Answer! Print #5,Chr$(19)+"^"; ! remise … l'‚tat initial Endif ' Gosub Rep_ini40 ' Gosub Emulm(0) @Vcurs(False) Ncurs!=False Clr Acurs|,Tcurs|,Ncurs! Ccurs&=&H700 Cnext|=&HFF Anext|=&HFF ' Cmnext|=&HFF ! m‚morisation des Cmnext|=0 ! m‚morisation des Amnext|=&HFF ! attributs Rmode!=False Vmode!=False Vtransp!=False ! plus de transparence Vdt_setme ' ---------------------------------------- Case &H4763 ! fin mode transp Vtransp!=False ! arrˆt mode transparence ' Default ! PRO2,PRO3 Select Spe|(0) Case "[" ! CSI Csi$=Csi$+Chr$(Spe|(1)) Spe|(Em_a&)=&HFF ! annuler, ne pas placer sur la pile If Len(Csi$)<10 ' If @T_csi(Csi$) ! trait‚ Clr Csi$ Else Em_a&=-1 ! on continue sinon Endif ' Else @Eminfo("Commande Csi-"+Csi$+" non reconnue!") Clr Csi$ ! on abandonne Endif ' Case "%" ! transp If Spe|(1)=64 ! fin Vtransp!=Not Vtransp! ! mode transparence! Else Vtransp!=True ! mode transparence! Endif Case "/" If Spe|(1)=63 ! fin Vtransp!=False Endif Case "!" ! tarification Em_a&=-1 Case " " ! invitation … num‚roter par exemple Em_a&=-1 ' Case 34 If Spe|(1)=34 Em_a&=-1 Endif Case "5" @Eminfo("Commande Esc+5 inconnue") Case "6" @Eminfo("Commande Esc+6 inconnue") Default Em_a&=-1 ! continuer Endselect Endselect Else Em_a&=-1 ! continuer Endif ' ' ------------------------------ Case 2 ! 3 params - PRO+2p ' ------------------------------ If Special&=31 Em_a&=-1 ! continuer Select Rol(Spe|(0),16)+Spe|(2) Case &H230030 ! reprise de t‚l = Xldrcs+Drset If Emulm|=0 Select Spe|(1) Case 33 To 126 @Eminfo("Avis de reprise de t‚l‚chargement G"+Chr$(48-Telmode!)+"'") Special&=&HFE ! Prise en compte de r‚ception Spe|(0)=Abs(Telmode!) ! GX' Spe|(1)=Spe|(1)-33 ! ID du char! Spe|(2)=&H0 ! GO! Arrayfill Spedr|(),0 ! Buff vide pour l'instant ' Em_a&=-1 ! cont! ' Endselect Endif Default Em_a&=-1 Endselect Else if Special&=27 ' Pro2 $1b3a $S% Select Rol(Spe|(0),16)+Rol(Spe|(1),8)+Spe|(2) Case &H232058 ! masque Case &H23205F ! d‚masque ' Case &H3A327E ! 40col @Eminfo("40 colonnes ->") ' If Emulm|<>0 If Emulm|<>0 If Answer! Print #5,Chr$(19)+"^"; ! ‚tat standard 40 col Endif ' Gosub Emulm(0) Em_d!=-1 ! redraw ' Endif Endif ' Case &H3A317D ! 80am @Eminfo("80 colonnes, am‚ricain ->") ' Gosub Rep_ini80 If Answer! Print #5,Chr$(27)+"[?z"; ! renvoi 80 col! Endif ' Gosub Emulm(2) ! 80 col Em_d!=-1 ! redraw ' Case &H3A327D ! 80fr @Eminfo("80 colonnes, fran‡ais ->") Gosub Rep_ini80 ' Gosub Emulm(1) ! 80 col Em_d!=-1 ! redraw ' Case &H3A6F31 ! (Esclave) @Eminfo("Esclave -") ! ne r‚pond rien Case &H3A7259 ! (Status clavier) @Eminfo("Demande status clavier ->") Gosub Rep_clav Case &H3A7C6A ! (Lprint fr) @Eminfo("Lprint: fr.") Case &H3A7C6B ! (Lprint am) @Eminfo("Lprint: am.") ' ' ------------------------------ ' Case &H5B3F7A ' Gosub Emulm(1) ! 80 col ' Em_d!=-1 ! redraw ' ' Case &H5B324A ! Cls ' Em_x&=X_curs& ' Em_y&=Y_curs& ' Gosub Vcls(Flag!) ' If Flag! ' Gosub Vcls_draw ' em_d!=-1 ! redraw ' Endif ' X_curs&=Em_x& ' Y_curs&=Em_y& ' ' Case &H5B3468 ! replace mode ' Vmode!=False ' ' Case &H5B346C ! insert mode ' Vmode!=True ' Case &H282042 ! Drcs text on (off cf 2 par) If Emulm|=0 Dmodet!=True If Not Btst(Acurs|,4) ! Justement, mode texte! Acurs|=Bset(Acurs|,7) ! DRCS Endif Endif ' Case &H292043 ! Drcs graph on If Emulm|=0 Dmodeg!=True If Btst(Acurs|,4) ! Justement, mode graphique! Acurs|=Bset(Acurs|,7) ! DRCS Endif Endif ' Case &H212220 ! ?? Em_a&=-1 ' Case &H202230 ! ?? ' Case &H22223C ! esc+""< ?? ' ' ------------------------------ ' ' Default ! non reconnu PRO+2p+nombre ' PRO2 + 1 param (=forcer 00 puis..) Select Rol(Spe|(0),16)+Rol(Spe|(1),8) Case &H3A6200 ! (Demande status module) @Eminfo("Demande status module ->") Gosub Rep_aig(Spe|(2)) Case &H3A6400 ! (Ack protocole/diffusion) @Eminfo("Ack protocole/diffusion.") Case &H3A6500 ! (Idem) @Eminfo("Ack protocole/diffusion.") Case &H3A6600 ! Transparence If Emulm|=0 Special&=&HFF ! TRA Spe|(0)=Spe|(2) Em_a&=-1 ! continuer Endif ' Case &H3A6900 ! (Lancement fonct) ' Select Spe|(2) Case "C" ! rouleau If Emulm|=0 Rmode!=True @Eminfo("Mode rouleau.") Gosub Rep_fonct Endif Case "D" ! PCE @Eminfo("Lancement fonctionnement PCE.") Gosub Rep_fonct Case "E" ! Min @Eminfo("Lancement fonctionnement min.") Gosub Rep_fonct Case "F" ! Loupe h @Eminfo("Lancement fonctionnement loupeH.") Case "G" ! Loupe b @Eminfo("Lancement fonctionnement loupeB.") Default @Eminfo("Lancement fonctionnement ??? .") Endselect ' Case &H3A6A00 ! (Arrˆt fonct) ' Select Spe|(2) Case "C" ! rouleau If Emulm|=0 Rmode!=False @Eminfo("Mode rouleau d‚sactiv‚.") Gosub Rep_fonct Endif Case "D" ! PCE @Eminfo("Arrˆt fonctionnement PCE.") Gosub Rep_fonct Case "E" ! Min @Eminfo("Arrˆt fonctionnement min.") Gosub Rep_fonct Case "F" ! Loupe h @Eminfo("Arrˆt fonctionnement loupeH.") Case "G" ! Loupe b @Eminfo("Arrˆt fonctionnement loupeB.") Default @Eminfo("Arrˆt fonctionnement ???") Endselect ' Case &H3A7100 ! (R‚p stat term) If Btst(Spe|(2),3)<>Connect! Connect!=Not Connect! If Connect! @Eminfo("Connexion") Else @Eminfo("D‚connexion") Endif If Flag! Vdraw(F_c&,0) Endif Else If Connect! @Eminfo("Connect‚") Else @Eminfo("D‚connect‚") Endif Endif Case &H3A7300 ! (R‚p stat fonct) @Eminfo("R‚ponse status fonctionnement") ' If Btst(Spe|(2),0) ! 80 colonnes!! If Emulm|=0 Gosub Emulm(1) ! 80 col Endif Else If Emulm|<>0 Gosub Emulm(0) ! 40 col Endif Endif ' If Btst(Spe|(2),1) Rmode!=True Else Rmode!=True Endif ' Case &H3A7500 ! (R‚p stat vitesse) @Eminfo("R‚ponse status vitesse") Case &H3A7700 ! (R‚p stat protocole) @Eminfo("R‚ponse status protocole") ' Default Select Rol(Spe|(0),8)+Spe|(2) Case &H2030 ! PAVI - num‚rotation @Eminfo("Veuillez entrez le code t‚l‚tel 361"+Chr$(18+Spe|(1))) ' Default Select Spe|(0) Case "!" ! tarification Em_a&=-1 ' Default Em_a&=-1 ! continuer Endselect Endselect Endselect ' Default Em_a&=-1 ! euh Endselect ' Else Em_a&=-1 ! continuer Endif ' ' ' ------------------------------ Case 3 ! 4 params - PRO+3p ' ------------------------------ ' Select Special& Case 31 ! US Select Rol(Spe|(0),24)+Rol(Spe|(1),16)+Rol(Spe|(2),8)+Spe|(3) Case &H23202020 ! T‚l‚chargement DRCS (d‚but de phrase) Em_a&=-1 ' Default Clr Special& Endselect Case 27 ! ESC Select Rol(Spe|(0),16)+Rol(Spe|(1),8)+Spe|(2) Case &H3B7359 ! +octet (R‚p status clav) If Btst(Spe|(3),0) @Eminfo("R‚ponse status clavier (‚tendu)") Else @Eminfo("R‚ponse status clavier (normal)") Endif ' Case &H3B6959 ! Programmation du clavier @Eminfo("Programmation du clavier") If Answer! Print #5,Pro3$+"sY"+Chr$(Spe|(3)); Endif Case &H3B6A59 ! @Eminfo("D‚programmation du clavier") If Answer! Print #5,Pro3$+"sY@"; Endif ' Default Select Rol(Spe|(0),16)+Rol(Spe|(1),8) ' Pro3 $1b3b Case &H3B6000,&H3B6100 ! Arrˆt/lancement aiguillage Select Rol(Spe|(1),8) Case &H6000 @Eminfo("Arrˆt aiguillage") Case &H6100 @Eminfo("Lancement aiguillage") Endselect ' Gosub Rep_aig(Spe|(2)) ' Case &H3B6300 ! r‚ponse status module @Eminfo("R‚ponse status module") ' Default Select Rol(Spe|(0),8)+Spe|(3) Case &H2130 ! tarification @Eminfo("Tarification T"+Chr$(Spe|(1)+16)+Chr$(Spe|(2)+16)) ' Default Clr Special& Endselect Endselect Endselect Default Clr Special& Endselect ' ' ------------------------------ Case 4 ! 5 params - PRO+3 par ' ------------------------------ ' If Special&=31 ! US Select Rol(Spe|(0),24)+Rol(Spe|(1),16)+Rol(Spe|(2),8)+Spe|(3) Case &H23202020 Select Spe|(4) Case &H42,&H43 ! T‚l‚chargement DRCS (d‚but de phrase) Em_a&=-1 ' Default Clr Special& Endselect Default Clr Special& Endselect Else Clr Special& Endif ' ' ------------------------------ Case 5 ! 6 params (exceptionnel!!) ' ------------------------------ ' If Special&=31 ! US Select Rol(Spe|(0),24)+Rol(Spe|(1),16)+Rol(Spe|(2),8)+Spe|(3) ' (US) 23 20 20 20 Case &H23202020 If Emulm|=0 Select Rol(Spe|(4),8)+Spe|(5) Case &H4249 ! Avis de t‚l‚chargement G0' ' print "Avis de t‚l‚chargement G0'" @Eminfo("Avis de t‚l‚chargement G0'") Special&=&HFE ! Prise en compte de r‚ception Spe|(0)=0 ! G0' Spe|(1)=&HFF ! Pas encoe de char Spe|(2)=&HFF ! Pas de demande d'envoi de char Em_a&=-1 ! cont! Telmode!=False ! texte, en cas de reprise ' Case &H4349 ! Avis de t‚l‚chargement G1' ' print "Avis de t‚l‚chargement G1'" @Eminfo("Avis de t‚l‚chargement G1'") Special&=&HFE ! Prise en compte de r‚ception Spe|(0)=1 ! G1' Spe|(1)=&HFF ! Pas encoe de char Spe|(2)=&HFF ! Pas de demande d'envoi de char Em_a&=-1 ! cont! Telmode!=True ! graph, en cas de reprise ' Endselect Endif Endselect ' Endif ' Default ! rang inconnu, on abandonne @Eminfo("Commande inconnue (interrompue) seg #2") Clr Special& Endselect ! nbr de params aprŠs le char spec. ' ------------------------------ ' Endif ! esc fulled? ' If Em_a&=-2 ! lancer param! Clr Em_a& Else if Em_a&<>-1 Clr Special& Endif ' Endif ' If Flag! If Em_d!=-1 Rdw_all(4) Endif Endif ' Return Procedure Echar(Var X&,Y&,C&,Flag!) ' Local T& ' $S& Lastc|=Byte(C&) Ec_t&=Tcurs| If Y&<=0 Select Ec_t& Case 1,3 ! Impossible en L0 Clr Ec_t& Endselect Else if X&=>Vmax_x& Select Ec_t& Case 2 ! Impossible en maxX Clr Ec_t& Case 3 ! Impossible en maxX, on remplace par haut Ec_t&=1 Endselect Else if X&=0 ! Pos 1,XX ; pas de fond possible alors If C&<>32 ! Pas esp ' Texte en plus? ' If Not Btst(Vida|(X&,Y&),4) If Not Btst(Acurs|,4) Ccurs&=And(Ccurs&,&HFF00) Endif Endif Else if Btst(Acurs|,4) Clr Ec_t& ! Graphique taille normale Endif ' C&=C& Or Ec_t&*&H100 ! Attrb taille Select Ec_t& Case 0 ! Normale Ecfix(X&,Y&,C&,Flag!) ! Fixer char c en xy avec col et attrbS Inc X& If X&>Vmax_x& If Y&<>0 And Emulm|=0 X&=0 Inc Y& Else X&=Vmax_x& Endif If Y&>Vmax_y& Y&=@Ynewcurs(1,Flag!) ! curs=1 ou scroller! ' Y&=1 ' Ccurs&=And(Ccurs&,&HFF00) ???? mais non!! on garde le fond! Endif Gosub Xvdt_setme(X&,Y&) ! comme vdt_setme mais avec x& et y& Endif ' Case 1 ! Haut Ecfix(X&,Y&,C&,Flag!) ! Fixer char c en xy avec col et attrbS Ecfix(X&,Y&-1,Bset(C&,8+2),Flag!) Inc X& If X&>Vmax_x& If Y&<>0 And Emulm|=0 X&=0 Add Y&,2 Else X&=Vmax_x& Endif If Y&>Vmax_y& ' Y&=2 Y&=@Ynewcurs(2,Flag!) ' Ccurs&=And(Ccurs&,&HFF00) ????? Endif Gosub Xvdt_setme(X&,Y&) ! comme vdt_setme mais avec x& et y& Endif ' Case 2 ! Large Ecfix(X&,Y&,C&,Flag!) ! Fixer char c en xy avec col et attrbS Ecfix(X&+1,Y&,Bset(C&,8+3),Flag!) Add X&,2 If X&>Vmax_x& If Y&<>0 And Emulm|=0 X&=0 Inc Y& Else X&=Vmax_x& Endif If Y&>Vmax_y& ' Y&=1 Y&=@Ynewcurs(1,Flag!) ! curs=1 ou scroller! ' Ccurs&=And(Ccurs&,&HFF00) ?????? Endif Gosub Xvdt_setme(X&,Y&) ! comme vdt_setme mais avec x& et y& Endif ' Case 3 ! Dble taille Ecfix(X&,Y&,C&,Flag!) ! Fixer char c en xy avec col et attrbS Ecfix(X&,Y&-1,Bset(C&,8+$ And And And And Eqv And ),Flag!) Ecfix(X&+1,Y&,Bset(C&,8+3),Flag!) Ecfix(X&+1,Y&-1,Bset(Bset(C&,8+2),8+3),Flag!) Add X&,2 If X&>Vmax_x& If Y&<>0 And Emulm|=0 X&=0 Add Y&,2 Else X&=Vmax_x& Endif If Y&>Vmax_y& ' Y&=2 Y&=@Ynewcurs(2,Flag!) ! curs=2 ou scroller! ' Ccurs&=And(Ccurs&,&HFF00) ?????? Endif Endif Endselect $S% ' ' Return Procedure Ecfix(X&,Y&,C&,Flag!) ' Vids&(X&,Y&)=C& If Emulm|=0 Vidc&(X&,Y&)=Ccurs& ' ' Au sujet de vida: si on ‚crit sur un starter block color, il s'annule et ' le restant de la ligne se remplit de la couleur actuelle (fond) ' ' Ah non, propagation mˆme sans Starter!! Ahh ce vid‚otex....... ' If Btst(Vida|(X&,Y&),5) ! starter!! (il s'annulera aprŠs) ' ' Propager, mais en couleur 0 If And(Vida|(X&+1,Y&),&X1100000)=0 ' Gosub Propagen(X&,Y&,Flag!) Gosub Propage(X&+1,Y&,Flag!) ' ' Eh non!!!! CF VDT_SETME/XVDT_SETME ' ' Gosub Propage0(X&,Y&,Flag!) ! +1 (‚liminer starter) Endif ' Else if Cnext|<>&HFF ! couleur prochaine ' Propager, normalement If And(Vida|(X&+1,Y&),&X1100000)=0 ' Gosub Propagen(X&,Y&,Flag!) Gosub Propage(X&+1,Y&,Flag!) Endif Else if Btst(Acurs|,4) ! graphique If And(Vida|(X&+1,Y&),&X1100000)=0 Gosub Propage(X&+1,Y&,Flag!) Endif Endif ' ' If Btst(Acurs|,4) ! graph Vida|(X&,Y&)=Bset(Acurs|,6) ! avec une d‚claration d'inhibition! Else Vida|(X&,Y&)=Acurs| Endif Else Vida|(X&,Y&)=Acurs| ! 80 col Endif If Flag! Gosub Vdraw(X&,Y&) Endif ' Return Procedure Ecatest(X&,Y&) ' teste si la couleur du caractŠre pr‚c‚dent doit ˆtre activ‚e par ex ' If Emulm|=0 If X&>0 ! Xcurs>0 If Not Btst(Acurs|,4) ! <>graph If Byte(Ccurs&)=0 And Not Btst(Acurs|,1) If Not Btst(Anext_t|,1) ! <>next line on If Anext|=&HFF And Cnext|=&HFF ! pas d'attrb en cours ' attrb/col <>? If (Byte(Vidc&(X&-1,Y&))<>Byte(Ccurs&)) Or (Btst(Acurs|,1)<>Btst(Vida|(X&-1,Y&),1)) ' Ccurs&=And(Ccurs&,&HFF00) Or Byte(Vidc&(X&-1,Y&)) Acurs|=Bclr(Bclr(Acurs|,5),1) If Not Btst(Vida|(X&-1,Y&),4) ! <>graph If Btst(Vida|(X&-1,Y&),1) Acurs|=Bset(Acurs|,1) Endif Endif ' Endif Endif Endif Endif ' Endif Endif Endif ' Return ' ' traite chaine CSI e$, -1 si trait‚ Function T_csi(E$) $F% Local A&,B&,N& Local X&,Y& ! params ' Select Right$(E$,1) Case "A" To "Z","a" To "z" ' on saute+‚value les params ex: Csi 12;34;5;6;7;8XXX Clr X&,Y& Clr N& A&=0 Repeat B&=1 While @Csi_n(Asc(Mid$(E$,A&+B&,1))) Inc B& Wend If B&<>1 If N&=0 X&=Val(Mid$(E$,A&+1,B&-1)) Else if N&=1 Y&=Val(Mid$(E$,A&+1,B&-1)) Endif Endif Inc N& Add A&,B& Until Mid$(E$,A&,1)<>";" Or A&>Len(E$) ' Print "Nb:";N&,"1=";X&,"2=";Y&,"Pos=";A& ' $S% Select Mid$(E$,A&,4) Case &H4D ! M, delete line at current position If Y_curs&<>0 ! CSI interdit sinon (ignor‚s) X&=Max(X&,1) X&=Min(X&,Vmax_y&-Y_curs&+1) Gosub Delline(X_curs&,Y_curs&,X&,Flag!) X_curs&=0 Endif Case &H4C ! L, insert one line at curent position If Y_curs&<>0 X&=Max(X&,1) X&=Min(X&,Vmax_y&-Y_curs&+1) Gosub Insline(X_curs&,Y_curs&,X&,Flag!) X_curs&=0 Endif Case &H50 ! delete character at current XY position If Y_curs&<>0 X&=Max(X&,1) X&=Min(X&,Vmax_x&-X_curs&+1) Gosub Delchar(X_curs&,Y_curs&,X&,Flag!) Endif Case &H68 ! insert If Y_curs&<>0 If X&=52 Vmode!=True Endif Endif Case &H6C ! replace If Y_curs&<>0 If X&=52 Vmode!=False Endif Endif Case &H42 ! Csi B Bas If Not Vtransp! If Y_curs&>0 ! Non line0 X&=Max(X&,1) Add Y_curs&,X& If Y_curs&>Vmax_y& Y_curs&=Vmax_y& Endif Vdt_setme Endif Endif Case &H41 ! Csi A hAut If Not Vtransp! If Y_curs&>0 ! Non line0 X&=Max(X&,1) Sub Y_curs&,X& If Y_curs&<1 Y_curs&=1 Endif Vdt_setme Endif Endif Case &H44 ! Csi D gauche If Not Vtransp! If Y_curs&>0 ! Non line0 X&=Max(X&,1) Sub X_curs&,X& If X_curs&<0 X_curs&=0 Endif Vdt_setme Endif Endif Case &H43 ! Csi C droite If Not Vtransp! If Y_curs&>0 ! Non line0 X&=Max(X&,1) Add X_curs&,X& If X_curs&>Vmax_x& X_curs&=Vmax_x& Endif Vdt_setme Endif Endif ' Case &H3F7A @Eminfo("80 colonnes ->") Gosub Rep_ini80 Gosub Emulm(1) ! 80 col Em_d!=-1 ! redraw Case &H3F7B @Eminfo("40 colonnes ->") If Answer! Print #5,Chr$(19)+"^"; ! ‚tat standard 40 col Endif Gosub Emulm(0) ! 40 col Em_d!=-1 ! redraw ' Case &H4A ! Cls If X&=&H32 Em_x&=X_curs& Em_y&=Y_curs& Gosub Vcls(Flag!) X_curs&=Em_x& Y_curs&=Em_y& Endif ' Case "H" ! pos If Y_curs&>0 ! Non line0 Swap X&,Y& ! invers‚s X&=Max(0,X&-1) X&=Min(X&,Vmax_x&) Y&=Max(1,Y&) Y&=Min(Y&,Vmax_y&) X_curs&=X& Y_curs&=Y& Vdt_setme Endif ' Case "m" If Emulm|<>0 Select X& Case 0 Clr Acurs| Case 1 Acurs|=Bset(Acurs|,2) ! light Case 4 Acurs|=Bset(Acurs|,1) ! soulign‚ Case 5 Acurs|=Bset(Acurs|,0) ! clignotant Case 7 Acurs|=Bset(Acurs|,3) ! invers‚ Case 9 Acurs|=Bset(Acurs|,4) ! altern‚ Case 13 Acurs|=Bset(Acurs|,9) ! alt '' Case 24 Acurs|=Bclr(Acurs|,1) ! souligne off Case 25 Acurs|=Bclr(Acurs|,0) ! clignote off Case 27 Acurs|=Bclr(Acurs|,3) ! inverse off Endselect Endif ' Default ! avort‚ ' Return True Endselect ' Case "{" If Csi$="?{" Return True Endif ' Default Return False Endselect ' Return True ! ok trait‚ Endfunc Function Csi_n(N&) $F% $S& Select N& Case "0" To "9" Return True Default Return False Endselect $S% Endfunc ' Procedure Rep_aig(A&) ' print "aiguillage" ' ' r‚ponses pr‚d‚finies... mais c'est mieux que rien! If Answer! $S& Select A& Case "X" ! R ‚cran Print #5,Pro3$+"c"+Chr$(A&)+"M"; Case "Y" ! R clavier Print #5,Pro3$+"c"+Chr$(A&)+"B"; Case "Z" ! R modem Print #5,Pro3$+"c"+Chr$(A&)+"F"; Case "[" ! R prise Print #5,Pro3$+"c"+Chr$(A&)+"J"; Case "P" ! E ‚cran Print #5,Pro3$+"c"+Chr$(A&)+"A"; Case "Q" ! E clavier Print #5,Pro3$+"c"+Chr$(A&)+"N"; Case "R" ! E modem Print #5,Pro3$+"c"+Chr$(A&)+"E"; Case "S" ! E prise Print #5,Pro3$+"c"+Chr$(A&)+"I"; Endselect $S% Endif Return Procedure Rep_fonct ! r‚ponse status fonctionnement ' print "fonct" If Answer! Em_z&=64 ! Bit #6 If Rmode! ! Rouleau Em_z&=Bset(Em_z&,1) Endif If Emulm|<>0 ! 80 colonnes Em_z&=Bset(Em_z&,0) Endif ' '''' ' Em_z&=Bset(Em_z&,2) ! PCE.. NAAAAAAAAAAAAAAAAANNNN!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 'Em_z&=Asc("F") ! r‚ponse du nitel ?????? Print #5,Pro2$+"s"+Chr$(Em_z&); Endif Return Procedure Rep_term ! r‚ponse status terminal ' print "terminal" If Answer! ' Print #5,Pro2$+"q"+Chr$(&X1011110); ! conect‚ Print #5,Pro2$+"q"+Chr$(&X1011011); ! connect‚ Endif Return Procedure Rep_vit ! r‚ponse status vitesse ' print "vitesse" If Answer! Print #5,Pro2$+"d"+Chr$(100); Endif Return Procedure Rep_protoc ! r‚ponse status protocole ' print "proto" If Answer! Print #5,Pro2$+"w"+Chr$(67); Endif Return Procedure Rep_id ! r‚ponse identification ' print " ident bv9" If Answer! Print #5,Chr$(1)+"Bv9"+Chr$(4); ! Id. Minitel 2 Endif Return Procedure Rep_ini40 ! remise … ‚tat initial (40 col) ' print "ini40" If Answer! ' Print #5,Chr$(19)+"^"; ! remise … l'‚tat initial Print #5,Sep$+"q"; Endif Return Procedure Rep_ini80 ! mise … l'‚tat 80 colonnes If Answer! ' Print #5,Chr$(27)+"[?z"; ! renvoi 80 col! Print #5,Sep$+"p"; Endif Return Procedure Rep_clav ! r‚ponse status clavier ' print "clav" If Answer! Print #5,Pro3$+"sY"+Chr$(64); Endif Return ' ' sauver/remettre ‚tatS en cas de pos en ligne 0: ils seront remis avec un simple curseur bas!! Procedure Keep_a0(Flag!) Local A& ' If Not Flag! Vsavet&(0)=X_curs& Vsavet&(1)=Y_curs& Vsavet&(2)=Ncurs! Vsavet&(3)=Acurs| Vsavet&(4)=Ccurs& Vsavet&(5)=Tcurs| Vsavet&(6)=Lstat! Vsavet&(7)=Cnext| Vsavet&(8)=Anext| Vsavet&(9)=Dmodet! Vsavet&(10)=Dmodeg! Vsavet&(11)=Cmnext| Vsavet&(12)=Amnext| ' Dmodet!=False Dmodeg!=False Acurs|=Bclr(Acurs|,7) ' ' Clr_spe ! init, en cas de s‚quence de chargement!! ' Clr Special& Else ' eh oui, on peut interrompre un chargement drcs!! For A&=0 To 5 Vsavet&(A&+13)=Spe|(A&) Next A& For A&=0 To 13 Vsavet&(A&+19)=Spedr|(A&) Next A& Vsavet&(33)=Special& Endif ' Return Procedure Restore_a0 Local A& ' X_curs&=Vsavet&(0) Y_curs&=Vsavet&(1) Ncurs!=Vsavet&(2) Acurs|=Vsavet&(3) Ccurs&=Vsavet&(4) Tcurs|=Vsavet&(5) Lstat!=Vsavet&(6) Cnext|=Vsavet&(7) Anext|=Vsavet&(8) Dmodet!=Vsavet&(9) Dmodeg!=Vsavet&(10) Cmnext|=Vsavet&(11) Amnext|=Vsavet&(12) For A&=0 To 5 Spe|(A&)=Vsavet&(A&+13) Next A& For A&=0 To 13 Spedr|(A&)=Vsavet&(A&+19) Next A& Special&=Vsavet&(33) ' Return Procedure Clr_a0 Local A& ' For A&=0 To 33 Vsavet&(A&)=0 Next A& Return ' Procedure Propagen(X&,Y&,Flag!) Gosub Propage(X&+1,Y&,Flag!) Return ' Propager la col fond + soulign‚ actuels aprŠs le starter Procedure Propage(X&,Y&,Flag!) Local N&,T&,T!,A! ' A!=False ! line: tout n'est pas soulign‚ (lettres hautes) If Btst(Anext_t|,1) ! line en m‚moire: propager If Btst(Anext|,1) Acurs|=Bset(Acurs|,1) Endif Endif N&=Byte(Vidc&(X&,Y&)) ' Tant que on ne rencontre pas un starter ni une col fond dif‚rente While And(Vida|(X&,Y&),&X1100000)=0 And Byte(Vidc&(X&,Y&))=N& And X&<=Vmax_x& ' couleur T&=Vidc&(X&,Y&) ' Vidc&(X&,Y&)=And(Vidc&(X&,Y&),&HFF00) Or Byte(Ccurs&) ' ' et lignage T!=((Btst(Vida|(X&,Y&),1))<>(Btst(Acurs|,1))) If T! ! a chang‚? If Btst(Acurs|,1) Vida|(X&,Y&)=Bset(Vida|(X&,Y&),1) If Btst(Vids&(X&,Y&),8+$ And And And And Eqv And ) ! <>lettre haute (partie haute) A!=True ! ne pas souligner comme un bourrin! Endif Else Vida|(X&,Y&)=Bclr(Vida|(X&,Y&),1) Endif Endif ' ' If Flag! ' a chang‚? ou restore line off? If (Vidc&(X&,Y&)<>T&) Or (T! And (Not Btst(Acurs|,1))) Gosub Vdraw(X&,Y&) ' Else if T! ! line Endif Endif ' Inc X& Wend If Btst(Acurs|,1) ! on a dessin‚ une ligne!! Gosub Prol Endif If Btst(Anext_t|,1) If Btst(Anext|,1) Acurs|=Bclr(Acurs|,1) Endif Endif ' Return Procedure Prol Local A&,B& ' ' sous routine de @propage - prolonge la ligne!! ' A&=@Wxacoord(4,Eccsizex&*X_curs&+Emx&) B&=@Wyacoord(4,Eccsizey&*Y_curs&+Emy&) @Vtext If Not A! Line A&,B&+Eccsizey&-1,A&+Eccsizex&*(X&-X_curs&)-1,B&+Eccsizey&-1 Else For T&=0 To X&-X_curs&-1 If Not Btst(Vids&(X_curs&+T&,Y_curs&),8+2) ! <>lettre haute (partie haute) Line A&+T&*Eccsizex&,B&+Eccsizey&-1,A&+Eccsizex&*(T&+1)-1,B&+Eccsizey&-1 Endif Next T& Endif ' Return ' Procedure Bl(Flag!) Local X&,Y&,B&,N&,L& Local X%,A%,B% Local A!,Dummy! Local B!,C! Local A| ' A|=Acurs| ' Y&=Y_curs& ! sauver pos B&=Ccurs& ! et col B!=Rmode! ! et rouleau C!=Vmode! Rmode!=False Vmode!=False L&=Cnext| Cnext|=&HFF Dummy!=False A!=Btst(Acurs|,1) ! lignage? For X%=X_curs& To Vmax_x& Vida|(X%,Y_curs&)=Acurs| N&=32 X&=X% Echar(X&,Y&,N&,Dummy!) Next X% If Flag! A%=@Wxacoord(4,Eccsizex&*X_curs&+Emx&) B%=@Wyacoord(4,Eccsizey&*Y_curs&+Emy&) ' Gosub Vfond(X_curs&,Y_curs&) Vf_x&=X_curs& Vf_y&=Y_curs& Gosub Vfond @Clip(W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) Gosub Pbox(A%,B%+Btst(Tcurs|,1)*Eccsizey&,A%+Eccsizex&*(Vmax_x&-X_curs&+1)-1,B%+Eccsizey&-1) If A! ! lignage Gosub Vtext Line A%,B%+Eccsizey&-1,A%+Eccsizex&*(Vmax_x&-X_curs&+1)-1,B%+Eccsizey&-1 Endif Gosub Deffill(Col1&,1,1) Endif Cnext|=L& ' Ccurs&=B& Acurs|=A| Rmode!=B! ! restorer rmode Vmode!=C! Return ' ' Procedure Delline(X&,Y&,N&,Flag!) Local A&,B&,A%,B%,X%,Y%,W%,H% ' X&=0 If Y&>0 N&=Min(N&,Vmax_y&-Y&) If N&>0 ! on peut d‚truire? For A&=0 To Vmax_x& For B&=Y&+N& To Vmax_y& Vids&(A&,B&-N&)=Vids&(A&,B&) Vida|(A&,B&-N&)=Vida|(A&,B&) ! attrb Vidc&(A&,B&-N&)=Vidc&(A&,B&) ! color Next B& Next A& ' If Flag! ! afficher? ' A%=@Wxacoord(4,Eccsizex&*X&+Emx&) If Vmax_y&-Y&-N&+1>0 A%=@Wxacoord(4,Emx&) B%=@Wyacoord(4,Eccsizey&*Y&+Emy&) Scr_cadrecopy(A%,B%+Eccsizey&*N&,(Vmax_x&+1)*Eccsizex&,(Vmax_y&+1-Y&-N&)*Eccsizey&,A%,B%,W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) Endif Endif ' Endif ' For B&=Vmax_y&-N&+1 To Vmax_y& For A&=0 To Vmax_x& Vids&(A&,B&)=32 Vida|(A&,B&)=&X1000000 ! Inhibiteur pour fond XXXX Vidc&(A&,B&)=&H700 ' If Flag! ' Gosub Vdraw(A&,B&) ' Endif Next A& Next B& ' If Flag! @Lhidem Bndary(0) A%=@Wxacoord(4,Emx&) B%=@Wyacoord(4,(Vmax_y&-N&+1)*Eccsizey&+Emy&) Gosub Deffill(Fcol&(0),Fstyl|(0),Findex|(0)) ! Stndrd ' Deffill 3 ! test ' ou Vfond(X&,Y&) ! Fond sp‚cial.. Gosub Pbox(A%,B%,A%+Eccsizex&*(Vmax_x&+1)-1,B%+Eccsizey&*N&-1) ! Box standard! Bndary(1) @Lshowm Endif ' Endif ' Return Procedure Insline(X&,Y&,N&,Flag!) Local A&,B&,A%,B%,X%,Y%,W%,H% ' X&=0 If Y&>0 N&=Min(N&,Vmax_y&-Y&) If N&>0 ! on peut d‚truire? For A&=0 To Vmax_x& For B&=Vmax_y& Downto Y&+N& Vids&(A&,B&)=Vids&(A&,B&-N&) Vida|(A&,B&)=Vida|(A&,B&-N&) ! attrb Vidc&(A&,B&)=Vidc&(A&,B&-N&) ! color Next B& Next A& ' If Flag! ! afficher? ' A%=@Wxacoord(4,Eccsizex&*X&+Emx&) If Vmax_y&-Y&-N&+1>0 A%=@Wxacoord(4,Emx&) B%=@Wyacoord(4,Eccsizey&*Y&+Emy&) Scr_cadrecopy(A%,B%,(Vmax_x&+1)*Eccsizex&,(Vmax_y&-Y&-N&+1)*Eccsizey&,A%,B%+Eccsizey&*N&,W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) Endif Endif ' Endif ' For B&=Y& To Y&+N&-1 For A&=0 To Vmax_x& Vids&(A&,B&)=32 Vida|(A&,B&)=&X1000000 ! Inhibiteur pour fond XXXX Vidc&(A&,B&)=&H700 ' If Flag! ' Gosub Vdraw(A&,B&) ' Endif Next A& Next B& ' If Flag! @Lhidem Bndary(0) A%=@Wxacoord(4,Emx&) B%=@Wyacoord(4,Y&*Eccsizey&+Emy&) Gosub Deffill(Fcol&(0),Fstyl|(0),Findex|(0)) ! Stndrd ' Deffill 2 !test ' ou Vfond(X&,Y&) ! Fond sp‚cial.. Gosub Pbox(A%,B%,A%+Eccsizex&*(Vmax_x&+1)-1,B%+Eccsizey&*N&-1) ! Box standard! Bndary(1) @Lshowm Endif ' Endif ' Return ' ' Note: ne prend pas en consid‚ration les tailles! (cf minitel) Procedure Delchar(X&,Y&,N&,Flag!) Local A& Local A%,B% ' If Y&>0 If X&0 @Lhidem Scr_copy(X%,Y%,W%,H%,X2%,Y2%) @Lshowm Endif Endif Endif ' Return ' Procedure Vdraw(X&,Y&) ' Local C&,A%,B%,Z&,W&,H&,Aff! ' Local A& ' ' Note: locaux remplac‚s par des globaux, plus rapide! ' Vd_e1& et Vd_e2& : Eccsizex&\2 et Eccsizex&\3 ' ' ' "Deftail(Vdt_tail&) Bndary(0) @Vcurs(False) Vd_a&=@Wxacoord(4,Eccsizex&*X&+Emx&) Vd_b&=@Wyacoord(4,Eccsizey&*Y&+Emy&) ' If vd_a%=>W_ix&(4) And vd_a%+Eccsizex&-1<=Min(W_ix&(4)+W_iw&(4),Work_out(0)) ' If vd_b%=>W_iy&(4) And vd_b%+Eccsizey&-1<=Min(W_iy&(4)+W_ih&(4),Work_out(1)) If Btst(Vidi|(X&,Y&),2) ! 'F'/'C' ? ' Graphmode (1) Gosub Deffill(Tcol&(7,0),Fstyl|(Intercol&(7)),Findex|(Intercol&(7))) Pbox Vd_a&,Vd_b&,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey&-1 Graphmode (2) Gosub Emul_text(0) Gosub Deftextcol(Fcol&(Intercol&(0))) If Connect! Text Vd_a&,Vd_b&+Decalt&(0),"C" Else Text Vd_a&,Vd_b&+Decalt&(0),"F" Endif ' Else If Not @Put_cache(Vd_a&,Vd_b&,X&,Y&) ' Vd_aff!=True ! Cache ' Clip(Max(vd_a%,W_ix&(4)),Max(vd_b%,W_iy&(4)),Eccsizex&,Eccsizey&) Graphmode (1) ' Gosub Vfond(X&,Y&) Vf_x&=X& Vf_y&=Y& Gosub Vfond Pbox Vd_a&,Vd_b&,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey&-1 Graphmode (2) ' Gosub Vtext(X&,Y&) Vf_x&=X& Vf_y&=Y& Gosub Vtext ' Clr Vd_w&,Vd_h& Vd_c&=Vids&(X&,Y&) If (Not Btst(Vida|(X&,Y&),7)) Or (Not Afdrc!) ! XXXXXXXXX ' If True If Btst(Vida|(X&,Y&),4)=False Or Emulm|<>0 ' Emul_text(And(Byte(Div(Vd_c&,&H100)),&X11)) ' $S& Select And(Byte(Div(Vd_c&,&H100)),&X1100) Case 0 ! normal Case &X100 ! high Vd_h&=Eccsizey& Case &X1000 ! right Vd_w&=-Eccsizex& Case &X1100 ! right & high Vd_h&=Eccsizey& Vd_w&=-Eccsizex& Endselect $S% ' ' ' Note: Eccsizey&-Z = D‚calage low line. Eccsizey&-(Eccsizey&-Z)=Z Add Vd_a&,Vd_w& Add Vd_b&,Vd_h& If Emulm|=0 ! vod‚otex $S& Select Byte(Vd_c&) Case 127 ! interdit ' vd_aff!=False Sub Vd_a&,Vd_w& Sub Vd_b&,Vd_h& Pbox Vd_a&,Vd_b&,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey&-1 Add Vd_a&,Vd_w& Add Vd_b&,Vd_h& Case 32 ' vd_aff!=False ' Ne rien faire! Case "{" Line Vd_a&,Vd_b&,Vd_a&,Vd_b&+Eccsizey&-1 Case "|" Line Vd_a&+Vd_e1&,Vd_b&,Vd_a&+Vd_e1&,Vd_b&+Eccsizey&-1 Case "}" Line Vd_a&+Eccsizex&-1,Vd_b&,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey& Case "~" Line Vd_a&,Vd_b&,Vd_a&+Eccsizex&-1,Vd_b& Case "`" Line Vd_a&,Vd_b&+Eccsizey&\2,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey&\2 Case "_" Line Vd_a&,Vd_b&+Eccsizey&-1,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey&-1 ' Default ! Texte normal Text Vd_a&,Vd_b&+Decalt&(0),Chr$(Vd_c&) Endselect $S% ' Else ' If Not Btst(Vida|(X&,Y&),5) ! caractŠre ANSI $S& Select Byte(Vd_c&) Case 32 ' vd_aff!=False ' Ne rien faire! Case "|" Line Vd_a&+Vd_e1&,Vd_b&,Vd_a&+Vd_e1&,Vd_b&+Eccsizey&-1 Case "_" Line Vd_a&,Vd_b&+Eccsizey&-1,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey&-1 Default Text Vd_a&,Vd_b&+Decalt&(0),Chr$(Vd_c&) Endselect $S% Else ! Fran‡ais $S& Select Byte(Vd_c&) Case 32 ' vd_aff!=False ' Ne rien faire! Case "{" Text Vd_a&,Vd_b&+Decalt&(0),"‚" Case "}" Text Vd_a&,Vd_b&+Decalt&(0),"Š" Case "|" Text Vd_a&,Vd_b&+Decalt&(0),"—" Case "~" Text Vd_a&,Vd_b&+Decalt&(0),Chr$(34) Case "[" Text Vd_a&,Vd_b&+Decalt&(0),"ø" Case "]" Text Vd_a&,Vd_b&+Decalt&(0),"Ý" Case "#" Text Vd_a&,Vd_b&+Decalt&(0),"œ" Case "_" Line Vd_a&,Vd_b&+Eccsizey&-1,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey&-1 Default Text Vd_a&,Vd_b&+Decalt&(0),Chr$(Vd_c&) Endselect $S% Endif Endif ' If Btst(Vida|(X&,Y&),1) ! lignage Select And(Byte(Div(Vd_c&,&H100)),&X1100) Case 0,&X1000 ! en bas Line Vd_a&,Vd_b&+Eccsizey&-1,Vd_a&+Eccsizex&,Vd_b&+Eccsizey&-1 Endselect Endif Sub Vd_a&,Vd_w& Sub Vd_b&,Vd_h& Gosub Deftext(Col1&,0) ' ' ======================================== Else ! graphique ' ======================================== ' Vd_z&=And(Bclr(Byte(Vd_c&),5),&X1011111) If Btst(Vd_z&,6) Vd_z&=Bset(Vd_z&,5) Vd_z&=Bclr(Vd_z&,6) Endif ' ' Bndary(0) If Btst(Vida|(X&,Y&),1)=False ! lignage off If Btst(Vd_z&,0) Pbox Vd_a&,Vd_b&,Vd_a&+Vd_e1&,Vd_b&+Vd_e2& Endif If Btst(Vd_z&,1) Pbox Vd_a&+Vd_e1&,Vd_b&,Vd_a&+Eccsizex&,Vd_b&+Vd_e2& Endif If Btst(Vd_z&,2) Pbox Vd_a&,Vd_b&+Vd_e2&,Vd_a&+Vd_e1&,Vd_b&+2*Vd_e2& Endif If Btst(Vd_z&,3) Pbox Vd_a&+Vd_e1&,Vd_b&+Vd_e2&,Vd_a&+Eccsizex&,Vd_b&+2*Vd_e2& Endif If Btst(Vd_z&,4) Pbox Vd_a&,Vd_b&+2*Vd_e2&,Vd_a&+Vd_e1&,Vd_b&+Eccsizey& Endif If Btst(Vd_z&,5) Pbox Vd_a&+Vd_e1&,Vd_b&+2*Vd_e2&,Vd_a&+Eccsizex&,Vd_b&+Eccsizey& Endif Else If Btst(Vd_z&,0) Pbox Vd_a&+1,Vd_b&+1,Vd_a&+Vd_e1&-1,Vd_b&+Vd_e2&-1 Endif If Btst(Vd_z&,1) Pbox Vd_a&+Vd_e1&+1,Vd_b&+1,Vd_a&+Eccsizex&-1,Vd_b&+Vd_e2&-1 Endif If Btst(Vd_z&,2) Pbox Vd_a&+1,Vd_b&+Vd_e2&+1,Vd_a&+Vd_e1&-1,Vd_b&+2*Vd_e2&-1 Endif If Btst(Vd_z&,3) Pbox Vd_a&+Vd_e1&+1,Vd_b&+Vd_e2&+1,Vd_a&+Eccsizex&-1,Vd_b&+2*Vd_e2&-1 Endif If Btst(Vd_z&,4) Pbox Vd_a&+1,Vd_b&+2*Vd_e2&+1,Vd_a&+Vd_e1&-1,Vd_b&+Eccsizey&-1 Endif If Btst(Vd_z&,5) Pbox Vd_a&+Vd_e1&+1,Vd_b&+2*Vd_e2&+1,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey&-1 Endif Endif ' Bndary(1) Endif ' Else ! ************* mode DRCS !! ****************** ' ' Clr vd_a2%,vd_b2% ! ce n'est qu'un offset!! ' ' Note: idem que pr‚c‚demment, sauf que nouveaux jeux .. ' En DRCS, pas de mosa‹que (si graphqie pas d'effets de taille etc) ' ' 12 ' 34 Clr Vd_part1!,Vd_part2!,Vd_part3!,Vd_part4! ! false = autoriser! Vdp_w&=0 Vdp_h&=0 If Btst(Vida|(X&,Y&),4)=False ! not graphique ' ' Note: contrairement … c qui se passait pour le graphique, ici ' le repŠre est le carr‚ en haut … gauche, ce qui fait que les valeurs sont ' un peu diff‚rentes... d‚sol‚!! (mais bcp plus simple!!) $S& Select And(Byte(Div(Vd_c&,&H100)),&X1100) Case 0 ! normal Select And(Byte(Div(Vd_c&,&H100)),&X11) Case 1,3 Vd_h&=-Eccsizey& ! vers le haut! Endselect Case &X100 ! high ' Vd_h&=Eccsizey& Case &X1000 ! right et bas -> d‚caler en haut et … gauche Select And(Byte(Div(Vd_c&,&H100)),&X11) Case 1,3 Vd_h&=-Eccsizey& Vd_w&=-Eccsizex& Case 2 Vd_w&=-Eccsizex& Endselect Case &X1100 ! right & high ' Vd_h&=Eccsizey& Vd_w&=-Eccsizex& Endselect $S% ' $S& Select And(Byte(Div(Vd_c&,&H100)),&X11) Case 0 ! all good Vdp_w&=0 Vdp_h&=0 Case &X1 ! dble hauteur Vdp_w&=0 Vdp_h&=1 If And(Byte(Div(Vd_c&,&H100)),&X1100)=0 Vd_part1!=True Vd_part2!=True ! aussi! Else Vd_part3!=True Vd_part4!=True ! idem! Endif Case &X10 ! dble larg Vdp_w&=1 Vdp_h&=0 If And(Byte(Div(Vd_c&,&H100)),&X1100)=0 Vd_part2!=True Vd_part4!=True Else Vd_part1!=True Vd_part3!=True Endif Case &X11 ! dble taille Vdp_w&=1 Vdp_h&=1 Vd_part1!=True Vd_part2!=True Vd_part3!=True Vd_part4!=True Select And(Byte(Div(Vd_c&,&H100)),&X1100) Case 0 Vd_part3!=False Case &X100 Vd_part1!=False Case &X1000 Vd_part4!=False Case &X1100 Vd_part2!=False Endselect Endselect $S% Endif ' ' ' Note: Eccsizey&-Z = D‚calage low line. Eccsizey&-(Eccsizey&-Z)=Z ' Add vd_a2%,Vd_w& ' Add vd_b2%,Vd_h& $S& Select Byte(Vd_c&) Case 127 ' vd_aff!=False ' Sub Vd_a&,Vd_w& ' Sub Vd_b&,Vd_h& Pbox Vd_a&,Vd_b&,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey&-1 ' Add Vd_a&,Vd_w& ' Add Vd_b&,Vd_h& Case 32 ' vd_aff!=False ' Ne rien faire! ' ' Default ! Texte normal Case 33 To 126 ' ' init box ' Gosub Xdbox(-1,0,@Wxacoord(4,Eccsizex&*X&+Emx&),@Wyacoord(4,Eccsizey&*Y&+Emy&)) Gosub Xdbox ' Vd_b2&=-(Btst(Vida|(X&,Y&),4)) ! graph? For Vd_a2&=(Vd_part1! And Vd_part2!)*-5 To $ And And And And Eqv Xor +(Vd_part3! And Vd_part4!)*5 ! 10 lignes Vd_z&=Edrcs|(Vd_b2&,Byte(Vd_c&)-33,Vd_a2&) If Not (Vd_part1! And Vd_part3!) If Btst(Vd_z&,7) Xd_x&=Vd_w& Xd_y&=Vd_h&+Vd_drm&(Vdp_h&,1,Vd_a2&) Xd_x2&=Vd_w&+Vd_drm&(Vdp_w&,2,0) Xd_y2&=Vd_h&+Vd_drm&(Vdp_h&,3,Vd_a2&) Gosub Xdbox2 Endif If Btst(Vd_z&,6) Xd_x&=Vd_w&+Vd_drm&(Vdp_w&,0,1) Xd_y&=Vd_h&+Vd_drm&(Vdp_h&,1,Vd_a2&) Xd_x2&=Vd_w&+Vd_drm&(Vdp_w&,2,1) Xd_y2&=Vd_h&+Vd_drm&(Vdp_h&,3,Vd_a2&) Gosub Xdbox2 Endif If Btst(Vd_z&,5) Xd_x&=Vd_w&+Vd_drm&(Vdp_w&,0,2) Xd_y&=Vd_h&+Vd_drm&(Vdp_h&,1,Vd_a2&) Xd_x2&=Vd_w&+Vd_drm&(Vdp_w&,2,2) Xd_y2&=Vd_h&+Vd_drm&(Vdp_h&,3,Vd_a2&) Gosub Xdbox2 Endif If Btst(Vd_z&,4) Xd_x&=Vd_w&+Vd_drm&(Vdp_w&,0,3) Xd_y&=Vd_h&+Vd_drm&(Vdp_h&,1,Vd_a2&) Xd_x2&=Vd_w&+Vd_drm&(Vdp_w&,2,3) Xd_y2&=Vd_h&+Vd_drm&(Vdp_h&,3,Vd_a2&) Gosub Xdbox2 Endif Endif ' If Not (Vd_part2! And Vd_part4!) If Btst(Vd_z&,3) Xd_x&=Vd_w&+Vd_drm&(Vdp_w&,0,4) Xd_y&=Vd_h&+Vd_drm&(Vdp_h&,1,Vd_a2&) Xd_x2&=Vd_w&+Vd_drm&(Vdp_w&,2,4) Xd_y2&=Vd_h&+Vd_drm&(Vdp_h&,3,Vd_a2&) Gosub Xdbox2 Endif If Btst(Vd_z&,2) Xd_x&=Vd_w&+Vd_drm&(Vdp_w&,0,5) Xd_y&=Vd_h&+Vd_drm&(Vdp_h&,1,Vd_a2&) Xd_x2&=Vd_w&+Vd_drm&(Vdp_w&,2,5) Xd_y2&=Vd_h&+Vd_drm&(Vdp_h&,3,Vd_a2&) Gosub Xdbox2 Endif If Btst(Vd_z&,1) Xd_x&=Vd_w&+Vd_drm&(Vdp_w&,0,6) Xd_y&=Vd_h&+Vd_drm&(Vdp_h&,1,Vd_a2&) Xd_x2&=Vd_w&+Vd_drm&(Vdp_w&,2,6) Xd_y2&=Vd_h&+Vd_drm&(Vdp_h&,3,Vd_a2&) Gosub Xdbox2 Endif If Btst(Vd_z&,0) Xd_x&=Vd_w&+Vd_drm&(Vdp_w&,0,7) Xd_y&=Vd_h&+Vd_drm&(Vdp_h&,1,Vd_a2&) Xd_x2&=Vd_w&+Vd_drm&(Vdp_w&,2,7) Xd_y2&=Vd_h&+Vd_drm&(Vdp_h&,3,Vd_a2&) Gosub Xdbox2 Endif Endif Next Vd_a2& ' Gosub Xd_exe ! exec!! ' Default ! non affichable pas DRCS (accents etc..) ' Emul_text(And(Byte(Div(Vd_c&,&H100)),&X11)) Text Vd_a&+Vd_w&,Vd_b&+Vd_h&+Decalt&(0),Chr$(Vd_c&) Endselect $S% ' ' Pour cache: Add Vd_a&,Vd_w& Add Vd_b&,Vd_h& ' If Btst(Vida|(X&,Y&),1) If Btst(Vida|(X&,Y&),4)=False ! NOT graphique Select And(Byte(Div(Vd_c&,&H100)),&X1100) Case 0,&X1000 ! en bas, sinon ne pas sousligner! ' Gosub Line(Vd_a&,Vd_b&+Eccsizey&-1,Vd_a&+Eccsizex&,Vd_b&+Eccsizey&-1) Line Vd_a&,Vd_b&+Eccsizey&-1,Vd_a&+Eccsizex&,Vd_b&+Eccsizey&-1 Endselect Endif Endif Sub Vd_a&,Vd_w& Sub Vd_b&,Vd_h& Gosub Deftext(Col1&,0) Endif Graphmode (0) ' If Vd_aff! ' Recopie de la ligne dans PutCache ' (pas de -1 : h+w de part et d'autre!) If Not (Vd_a&Clip_x&+Clip_w& Or Vd_b&+Eccsizey&>Clip_y&+Clip_h&) Get_cache(Vd_a&,Vd_b&,X&,Y&) Endif Endif ' Endif ! test put cache ' Endif ! tester 'F' / 'C' ' ' Endif ! idem \/ ' Endif ! test d‚passement ' Return ' Set color, fond et text - X& et Y& Procedure Vfond ' Local N& ' Vf_n& ' ' Abs(Btst(Vida|(x&,y&),0))=clignotant ou non! If Emulm|=0 If Btst(Vida|(Vf_x&,Vf_y&),3) ! invers‚? Vf_n&=Intercol&(Min(7,Max(0,Byte(Div(Vidc&(Vf_x&,Vf_y&),&H100))))) ! texte Xd_c2&=Tcol&(Vf_n&,Abs(Btst(Vida|(Vf_x&,Vf_y&),0))) Gosub Deffill(Xd_c2&,Fstyl|(Vf_n&),Findex|(Vf_n&)) Gosub Deftextcol(Xd_c2&) Gosub Color(Xd_c2&) Else Vf_n&=Intercol&(Min(Max(0,Byte(Vidc&(Vf_x&,Vf_y&))),7)) ! fond Xd_c2&=Fcol&(Vf_n&) Gosub Deffill(Xd_c2&,Fstyl|(Vf_n&),Findex|(Vf_n&)) Gosub Deftextcol(Xd_c2&) Gosub Color(Xd_c2&) Endif ' Else If Btst(Vida|(Vf_x&,Vf_y&),3) ! invers‚ If Btst(Vida|(Vf_x&,Vf_y&),2) ! light Vf_n&=7 Else Vf_n&=4 Endif Else If Btst(Vida|(Vf_x&,Vf_y&),2) ! light Vf_n&=0 Else Vf_n&=0 Endif Endif Xd_c2&=Fcol&(Vf_n&) Gosub Color(Xd_c2&) Gosub Deftextcol(Xd_c2&) Gosub Deffill(Xd_c2&,Fstyl|(Vf_n&),Findex|(Vf_n&)) Endif Return Procedure Vtext ' Local N& ' Vf_N& ' If Emulm|=0 If Btst(Vida|(Vf_x&,Vf_y&),3) ! invers‚? Vf_n&=Intercol&(Min(Max(0,Byte(Vidc&(Vf_x&,Vf_y&))),7)) ! fond Xd_c1&=Fcol&(Vf_n&) Gosub Deftextcol(Xd_c1&) Gosub Color(Xd_c1&) Gosub Deffill(Xd_c1&,Fstyl|(Vf_n&),Findex|(Vf_n&)) Else Vf_n&=Intercol&(Min(7,Max(0,Byte(Div(Vidc&(Vf_x&,Vf_y&),&H100))))) ! texte Xd_c1&=Tcol&(Vf_n&,Abs(Btst(Vida|(Vf_x&,Vf_y&),0))) Gosub Deftextcol(Xd_c1&) Gosub Color(Xd_c1&) Gosub Deffill(Xd_c1&,1,1)! (graph) Endif Else If Not Btst(Vida|(Vf_x&,Vf_y&),3) ! non invers‚ If Btst(Vida|(Vf_x&,Vf_y&),2) ! light Vf_n&=7 Else Vf_n&=4 Endif Else If Btst(Vida|(Vf_x&,Vf_y&),2) ! light Vf_n&=0 Else Vf_n&=0 Endif Endif ' Vf_n&=Intercol&(7) Xd_c1&=Tcol&(Vf_n&,Abs(Btst(Vida|(Vf_x&,Vf_y&),0))) Gosub Deftextcol(Xd_c1&) Gosub Color(Xd_c1&) Gosub Deffill(Xd_c1&,1,1)! (graph) ' Endif Return ' ' Extended DRCS box - proc 68000 - $P< ' 1) Init Procedure Xdbox ' Pas assez de place? If Vd_a&Clip_x&+Clip_w& Or Vd_b&+Eccsizey&>Clip_y&+Clip_h& Set_xd!=False Else Set_xd!=True Arrayfill Drbit|(),0 Endif ' Return ' 2) drawing -"optimis‚e" Procedure Xdbox2 ' Local A&,B&,C& ' (local Xd_x&,xd_b&,Xd_c&) ' If Set_xd! ' Repeat Xd_a&=Xd_x& Repeat Xd_c&=Xd_a& Add Xd_c&,Xd_y&*Drbitw& ! pos du bit en bits Xd_1&=Div(Xd_c&,8) Xd_2&=7-Mod(Xd_c&,8) Drbit|(Xd_1&)=Bset(Drbit|(Xd_1&),Xd_2&) Inc Xd_a& Until Xd_a&>Xd_x2& Inc Xd_y& Until Xd_y&>Xd_y2& ' Else Pbox Vd_a&+Xd_x&,Vd_b&+Xd_y&,Vd_a&+Xd_x2&,Vd_b&+Xd_y2& Endif ' Return ' 3) exec! Procedure Xd_exe If Set_xd! @Lhidem ' ' STS, cleaner than the galaxy! G_s&(0)=Word(Swap(V:Drbit|(0))) G_s&(1)=Word(V:Drbit|(0)) G_s&(2)=Drbitw& G_s&(3)=Eccsizey& G_s&(4)=Drbitw&\16 G_s&(5)=0 G_s&(6)=1 ! Mono G_s&(7)=0 G_s&(8)=0 G_s&(9)=0 ' Contrl(0)=121 ! Copy raster transparent Contrl(1)=4 Contrl(3)=3 Contrl(6)=V~h Intin(0)=1 ! GraphMode Intin(1)=Xd_c1& ! Couleur Intin(2)=Xd_c2& ! et fond Ptsin(0)=0 ! Coord src Ptsin(1)=0 Ptsin(2)=Drbitw&-1 ! Coord src Ptsin(3)=Eccsizey&-1 Ptsin(4)=Vd_a& ! Coord src dest Ptsin(5)=Vd_b& Ptsin(6)=Vd_a&+Drbitw&-1 ! Coord src dest Ptsin(7)=Vd_b&+Eccsizey&-1 ' Contrl(7)=Word(Swap(V:G_s&(0))) Contrl(8)=Word(V:G_s&(0)) Contrl(9)=Word(Swap(V:G_screen%(0))) Contrl(10)=Word(V:G_screen%(0)) Vdisys ! EXECUTER! @Lshowm Endif ' Return $P> ' ' ' D‚sinterlacage Function Intercol(N&) $F% ' $S& Select N& Case 0 Return 0 Case 1 Return 2 Case 2 Return 4 Case 3 Return 6 Case 4 Return 1 Case 5 Return 3 Case 6 Return 5 Case 7 Return 7 Endselect $S% ' Endfunc ' ' Interlacage Function Extercol(N&) $F% ' $S& Select N& Case 0 Return 0 Case 1 Return 4 Case 2 Return 1 Case 3 Return 5 Case 4 Return 2 Case 5 Return 6 Case 6 Return 3 Case 7 Return 7 Endselect $S% ' Endfunc ' ' Cache get (‚mulateur) Procedure Get_cache(A%,B%,X&,Y&) ' Local C$ ' ' ' SystŠme du roving pointer: on tourne en rond, les donn‚es les plus fraŒches ' sont dispo en premier. (Optimisation) ' If Linea! ' @Lhidem ' Get A%,B%,A%+Eccsizex&-1,B%+Eccsizey&-1,Gc_c$ ! tout betement ' @Lshowm ' Else ' @Get(A%,B%,A%+Eccsizex&-1,B%+Eccsizey&-1,Gc_c$) ' Endif ' ' Gosub Cget(A%,B%,Caches%+Cachexx%*Rovcach&) ' ' cache$(Rovcach&)=Gc_c$ Cachs&(Rovcach&)=Vids&(X&,Y&) Cachc&(Rovcach&)=Vidc&(X&,Y&) Cacha|(Rovcach&)=Bclr(Bclr(Vida|(X&,Y&),6),5) Inc Rovcach& If Rovcach&>Ncach& ! Le roving fait une boucle (et ron et ron..) Rovcach&=0 Endif ' Clr Gc_c$ ' Return ' ' Cache put (idem) Function Put_cache(A&,B&,X&,Y&) $F% ' Local A& ' Pc_a& ' ' If Btst(Bios(11,-1),1) ! shift ' Return False ' Endif ' If Byte(Vids&(X&,Y&))=32 ! Espace? If And(Vida|(X&,Y&),&X1010)=0 ! Pas de line ni inv ' @Lhidem Bndary(0) If Byte(Vidc&(X&,Y&))=0 ! Fond Gosub Deffill(Fcol&(0),Fstyl|(0),Findex|(0)) ! Stndrd Else ' Vfond(X&,Y&) ! Fond sp‚cial.. Vf_x&=X& Vf_y&=Y& Vfond Endif ' Gosub Pbox(A&,B&,A&+Eccsizex&-1,B&+Eccsizey&-1) ! Box standard! Pbox A&,B&,A&+Eccsizex&-1,B&+Eccsizey&-1 ! Box standard! ' @Lshowm Return True Endif Endif ' ' Ca sort des limites de l'‚cran If A&Clip_x&+Clip_w& Or B&+Eccsizey&>Clip_y&+Clip_h& ' Dessiner … la main! Return False Endif ' ' Pc_a&=C:Cache%(W:Vids&(X&,Y&),W:Vidc&(X&,Y&),W:Vida|(X&,Y&),L:V:Cachs&(0),L:V:Cachc&(0),L:V:Cacha|(0),W:Ncach&) If Pc_a&=>0 If Pc_a&<=Ncach& ' If Linea! @Lhidem ' Put A&,B&,cache$(Pc_a&),Set_putmode& ! tout bˆtement @Cput(A&,B&,Caches%+Pc_a&*Cachexx%) @Lshowm ' Else ' @Put(A&,B&,cache$(Pc_a&)) ' Endif Return True Else ~@Form_alert(1,"[3][Attention!|Erreur grave d‚tect‚e|GPUT/Cache: d‚bordement|A signaler..][ Je note ]") ~@Form_alert(1,"[3][|Gcache_ext=#"+Str$(Pc_a&)+"|$"+Hex$(Pc_a&,4)+"][ A‹e ]") Endif Endif ' Return False Endfunc ' Procedure Vcurs(Flag!) ' Local A%,B% ' If Ncurs! Vc_a&=@Wxacoord(4,Eccsizex&*X_curs&+Emx&) Vc_b&=@Wyacoord(4,Eccsizey&*Y_curs&+Emy&) If Vc_a&=>W_ix&(4) And Vc_a&+Eccsizex&-1<=W_ix&(4)+W_iw&(4) If Vc_b&=>W_iy&(4) And Vc_b&+Eccsizey&-1<=W_iy&(4)+W_ih&(4) ' If Flag!=False And Vcr!=True Vcr!=False Vdraw(X_curs&,Y_curs&) Else if Flag!=True And Vcr!=False Vcr!=True ' Clip vc_a%,vc_b%,Eccsizex&,Eccsizey& ' Clip_off ' Deffill Col1& @Bndary(0) Graphmode (3) Gosub Deffill(Col1&,1,1) Gosub Pbox(Vc_a&,Vc_b&,Vc_a&+Eccsizex&-1,Vc_b&+Eccsizey&-1) Graphmode (1) Endif Endif Endif Endif @Sweety_text ' Return ' Procedure Emuledraw(X&,Y&,W&,H&) Local X2&,Y2& ' @Lhidem Bndary(0) X&=Max(X&,0) Y&=Max(Y&,0) W&=W&\Eccsizex&+2 H&=H&\Eccsizey&+2 X&=Min(Vmax_x&,Max(0,X&\Eccsizex&-1)) Y&=Min(Vmax_y&,Max(0,Y&\Eccsizey&-1)) W&=Min(X&+W&,Vmax_x&)-X& H&=Min(Y&+H&,Vmax_y&)-Y& ' If W&>0 And H&>0 For Y2&=Y& To Y&+H& Exit if @Shiftbrk For X2&=X& To X&+W& ' If Byte(Vids&(X2&,Y2&))=32 ! spc If Byte(Vidc&(X2&,Y2&))=0 ! fond 0 If And(Vida|(X2&,Y2&),&X1010)=0 ! ni line ni inv If Btst(Vidi|(X2&,Y2&),2) ! 'F' Vdraw(X2&,Y2&) Endif Else Vdraw(X2&,Y2&) Endif Else Vdraw(X2&,Y2&) Endif Else Vdraw(X2&,Y2&) Endif Next X2& Next Y2& Endif @Sweety_text @Lshowm Return ' Procedure Vcls(Flag!) Local Y&,X& ' Clr Vtransp! If Flag! @Vcurs(False) Endif Clr Special& ! reset Clr_spe ' X_curs&=0 Y_curs&=1 Cnext|=&HFF Anext|=&HFF Cmnext|=&HFF Amnext|=&HFF Acurs|=And(Acurs|,128) Ccurs&=&H700 Tcurs|=0 For Y&=1 To Vmax_y& For X&=0 To Vmax_x& Vidc&(X&,Y&)=&H700 Vids&(X&,Y&)=32 Vida|(X&,Y&)=&X1000000 ! Inhibiteur pour fond XXXX Next X& Next Y& ' ' Repassage en texte, mais est-ce du drcs?? If Dmodet! Acurs|=Bset(Acurs|,7) ! DRCS Else Acurs|=Bclr(Acurs|,7) ! TEXT Endif ' If Flag! @Vcls_draw @Vcurs(False) Endif ' Return Procedure Vcls_draw ' Local X& Local A%,B% ' @Wind_clip(4) ! clipping sur window 4 ' Draw_e(0,0,0,0) ! dessiner cadre (effacer) @Lhidem Bndary(0) A%=@Wxacoord(4,Emx&) B%=@Wyacoord(4,Eccsizey&+Emy&) Gosub Deffill(Fcol&(0),Fstyl|(0),Findex|(0)) ! Stndrd ' Deffill 3 ! test ' ou Vfond(X&,Y&) ! Fond sp‚cial.. Gosub Pbox(A%,B%,A%+Eccsizex&*(Vmax_x&+1)-1,B%+Eccsizey&*Vmax_y&-1) ! Box standard! Bndary(1) @Lshowm ' ' For X&=0 To Vmax_x& ' Gosub Vdraw(X&,0) ' Next X& ' Return ' Procedure Ycurs1 Y_curs&=1 Ccurs&=And(Ccurs&,&HFF00) Return ' Function Ynewcurs(C&,Flag!) $F% ' If Rmode! Or Emulm|<>0 Gosub Delline(1,1,C&,Flag!) Return Vmax_y&-C&+1 Else Return C& Endif Endfunc ' ' Attrb courants au curseur (pour d‚placements uniq.) Procedure Vdt_setme ' ' Si on tombe sur un 'starting block' de couleur de fond, on doit ' r‚gler la couleur actuelle de fond sur z‚ro! (eh oui!!) ce qui permet ' d'effacer des portions de barres de couleur juste en ecrivant ' sur leur header un caractŠre aprŠs un pos. ' If Emulm|=0 If Not Btst(Acurs|,4) ! si texte! ' Acurs|=Vida|(X_curs&,Y_curs&) Ccurs&=And(Ccurs&,&HFF00) ! On garde la col d'origine Acurs|=Bclr(Acurs|,1) ! Et lignage off ' NOT Start back color block If Not Btst(Vida|(X_curs&,Y_curs&),5) ' Ccurs&=Ccurs& Or Byte(Vidc&(X_curs&,Y_curs&)) If X_curs&>0 Ccurs&=Ccurs& Or Byte(Vidc&(X_curs&,Y_curs&)) If Not Btst(Vida|(X_curs&,Y_curs&),4) ! <>graph (mosaique) If Btst(Vida|(X_curs&,Y_curs&),1) ! lignage Acurs|=Bset(Acurs|,1) Endif Endif Endif Endif Endif Endif Return ' ' Vars internes X& et Y&, pas pour les d‚placements Procedure Xvdt_setme(X&,Y&) ' If Not Btst(Acurs|,4) ! texte, sinon rien … faire! ' Ccurs&=And(Ccurs&,&HFF00) ! On garde la col d'origine Acurs|=Bclr(Acurs|,1) ! plus de soulignement ' If Not Btst(Vida|(X&,Y&),5) ' ' Ccurs&=Ccurs& Or Byte(Vidc&(X&,Y&)) ! ???????????????????????? ' Endif Endif ' Return ' ' ' Function Emulek(Key&,Flag!) $F% Local A& Local A! ' If Help! A&=Key& Gosub Help(4,A&) Key&=A& ' a=0 -> annul‚ Endif ' If Key&=161 And Not Btst(@Shift,2) ! help Exdo!=True Clr Key& Do A&=Byte(@Form_exdo(6,Am_se&)) ~@Wind_update01(0) Ob_state(Adr%(6),A&)=Bclr(Ob_state(Adr%(6),A&),0) Gosub Defmouse(2) $S& Select A& Case Am_con& ! cnx Key&=3 Case Am_som& ! som Key&=226 Case Am_ann& ! annul Key&=225 Case Am_ret& ! ret Key&=200 Case Am_rep& ! rep Key&=27 Case Am_gui& ! guide Key&=199 Case Am_cor& ! corr Key&=8 Case Am_sui& ! suite Key&=208 Case Am_env& ! envoi Key&=13 ' Case Am_seq& ! s‚quence … envoyer Outvid(Char{{Ob_spec(Adr%(6),Am_se&)}}) Case Am_se2& If Char{{Ob_spec(Adr%(6),Am_se&)}}<>"" Outvid(Char{{Ob_spec(Adr%(6),Am_se&)}}+Chr$(13)) Char{{Ob_spec(Adr%(6),Am_se&)}}="" ~Objc_draw(Adr%(6),Am_se&,7,Rx&(6),Ry&(6),Rw&(6),Rh&(6)) Else Key&=0 A&=Am_cancel& Endif Case Am_com& ! composer no tel If Set_speed! Outvid(Pro1$+"S") Pause 5 Outvid(Pro3$+"a\S") Pause 10 Outvid(Char{{Ob_spec(Adr%(6),Am_co&)}}) Pause 15 Outvid(Pro1$+"h") Else Atsend(Modem$(4)) ! prise de ligne Atsend(Char{{Ob_spec(Adr%(6),Am_co&)}}) ! num‚ro Atsend(Modem$(2)) ! connect Endif Case Am_first& To Am_last& ! composer no tel ' If Not Btst(A&,15) If Set_speed! Outvid(Pro1$+"S") Pause 5 Outvid(Pro3$+"a\S") Pause 10 Outvid(Char{{Ob_spec(Adr%(6),A&)}}) Pause 15 Outvid(Pro1$+"h") Else Atsend(Modem$(4)) ! prise de ligne Atsend(Char{{Ob_spec(Adr%(6),A&)}}) ! num‚ro Atsend(Modem$(2)) ! connect Endif ' Else ' Char{{Ob_spec(Adr%(6),Byte(A&))}}=Left$(Char{{Ob_spec(Adr%(6),Am_co&)}},12) ' Endif Case Am_cnx& ! cnx If Set_speed! Outvid(Pro1$+"h") Pause 10 Else Atsend(Modem$(2)) Endif Case Am_dcn& ! d‚cnx If Set_speed! Outvid(Pro1$+"g") Pause 10 Else Atsend(Modem$(3)) Endif Case Am_lin& ! prise de ligne If Set_speed! Outvid(Pro1$+"S"+Pro3$+"a\S") Pause 10 Else Atsend(Modem$(4)) Endif Case Am_lib& ! lib‚ration If Set_speed! Outvid(Pro1$+"W") Pause 10 Else Atsend(Modem$(5)) Endif ' ' Default Case 0,1,Am_cancel& Key&=0 A&=Am_cancel& Default Clr A& Clr Key& Endselect $S% Gosub Defmouse(0) ~Objc_draw(Adr%(6),A&,7,Rx&(6),Ry&(6),Rw&(6),Rh&(6)) Loop until (A&=Am_cancel&) Or Key&>0 ' ~form_dial(3,0,0,0,0,Rx&(6),Ry&(6),Rw&(6),Rh&(6)) ~@Form_exdo(6,-3) ' Else if Key&=161 Or Key&=174 ! ^Help r‚gler cache If Afdrc! Ob_state(Adr%(7),Cv_vd&)=Bset(Ob_state(Adr%(7),Cv_vd&),0) Else Ob_state(Adr%(7),Cv_vd&)=Bclr(Ob_state(Adr%(7),Cv_vd&),0) Endif Char{{Ob_spec(Adr%(7),Cv_ch&)}}=Str$(@Bitlen(Eccsizex&,Eccsizey&)-4,8) Char{{Ob_spec(Adr%(7),Cv_gl&)}}=Str$((@Bitlen(Eccsizex&,Eccsizey&)-4)*(Ncach&+1),8) Char{{Ob_spec(Adr%(7),Cv_tl&)}}=Str$(Ncach&+1,4) Exdo!=True Do A&=Byte(@Form_exdo(7,0)) ~Objc_change(Adr%(7),A&,0,Rx&(7),Ry&(7),Rw&(7),Rh&(7),Bclr(Ob_state(Adr%(7),A&),0),1) $S& Select A& Case Cv_in& Gosub Defmouse(2) Gosub Cache_uninit Ncach&=Val(Char{{Ob_spec(Adr%(7),Cv_tl&)}})-1 Ncach&=Max(24,Ncach&) Ncach&=Min(4096,Ncach&) ! pas trop qd mˆme!! (4 pages ca suffit!) Ncach&=Min((Malloc(-1)-Limit%)/(@Bitlen(Eccsizex&,Eccsizey&)+15),Ncach&) Ncach&=Max(2,Ncach&) Gosub Cache_init Char{{Ob_spec(Adr%(7),Cv_ch&)}}=Str$(@Bitlen(Eccsizex&,Eccsizey&)-4,8) Char{{Ob_spec(Adr%(7),Cv_gl&)}}=Str$((@Bitlen(Eccsizex&,Eccsizey&)-4)*(Ncach&+1),8) Char{{Ob_spec(Adr%(7),Cv_tl&)}}=Str$(Ncach&+1,4) ~Objc_draw(Adr%(7),Cv_ch&,255,Rx&(7),Ry&(7),Rw&(7),Rh&(7)) ~Objc_draw(Adr%(7),Cv_gl&,255,Rx&(7),Ry&(7),Rw&(7),Rh&(7)) ~Objc_draw(Adr%(7),Cv_tl&,255,Rx&(7),Ry&(7),Rw&(7),Rh&(7)) ~Fre(0) Gosub Defmouse(0) Case Cv_ok&,0,1 If Btst(Ob_state(Adr%(7),Cv_vd&),0) Gosub Cache_uninit Afdrc!=True Gosub Cache_init Else Gosub Cache_uninit Afdrc!=False Gosub Cache_init Endif Exit if True Endselect $S% Loop ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(7),Ry&(7),Rw&(7),Rh&(7)) ~@Form_exdo(7,-3) ' Endif ' If Not Flag! A!=Redir! Redir!=False $S& Select Key& ' Case 5,187 To 196,212 To 221 Flag!=True ' Case 13 ! Enter If Connect! Or Set_speed! Send(Sep$+"A") ~@Infow(4,"/Envoi") Else Send(Chr$(13)) ~@Infow(4,"/Cr") Endif Case 10 ! ^Enter Send(Chr$(13)+Chr$(10)) ~@Infow(4,"/RETURN (CR/LF)") Case 208 ! Suite Send(Sep$+"H") ~@Infow(4,"/Suite") Case 200 ! Retour Send(Sep$+"B") ~@Infow(4,"/Retour") Case 27 ! Repet Send(Sep$+"C") ~@Infow(4,"/R‚p‚tition") Case 225 ! Annul UNDO Send(Sep$+"E") ~@Infow(4,"/Annulation") Case 199 ! Clh home=Guide Send(Sep$+"D") ~@Infow(4,"/Guide") Case 226,2260 ! Help=sommaire Send(Sep$+"F") ~@Infow(4,"/Sommaire") Case 8,203 ! Back Correction If Connect! Or Set_speed! Send(Sep$+"G") ~@Infow(4,"/Correction") Else Send(Chr$(8)) ~@Infow(4,"/Backspace") Endif Case 3 ! ^C cnx fin Send(Sep$+"I") ~@Infow(4,"/Connexion/Fin") Case 205 ~@Infow(4,"/' '") Send(Chr$(32)) Case 32 To 255 ~@Infow(4,"/'"+Chr$(Key&)+"'") Send(Chr$(Key&)) ' Default Flag!=True ' Endselect $S% Redir!=A! Endif ' If Flag! $S& Select Key& Case 0 Case 147 ! Redirection ' 'Redir!=@Form_alert(Abs(Redir!)+1,"[2][|Le terminal doit il ˆtre |l'‚mulateur?|][Confirmer| Non ]")=1 ' Ob_state(Adr%(39),Es_emu&)=Bclr(Ob_state(Adr%(39),Es_emu&),0) Ob_state(Adr%(39),Es_emr&)=Bclr(Ob_state(Adr%(39),Es_emr&),0) Ob_state(Adr%(39),Es_des&)=Bclr(Ob_state(Adr%(39),Es_des&),0) Ob_state(Adr%(39),Es_off&)=Bclr(Ob_state(Adr%(39),Es_off&),0) ' If Emul! If Recept! Ob_state(Adr%(39),Es_emu&)=Bset(Ob_state(Adr%(39),Es_emu&),0) Else Ob_state(Adr%(39),Es_off&)=Bset(Ob_state(Adr%(39),Es_off&),0) Endif Else If Recept! Ob_state(Adr%(39),Es_emr&)=Bset(Ob_state(Adr%(39),Es_emr&),0) Else Ob_state(Adr%(39),Es_des&)=Bset(Ob_state(Adr%(39),Es_des&),0) Endif Endif ' If Answer! Ob_state(Adr%(39),Es_rep&)=Bset(Ob_state(Adr%(39),Es_rep&),0) Else Ob_state(Adr%(39),Es_rep&)=Bclr(Ob_state(Adr%(39),Es_rep&),0) Endif ' If Connect! Ob_state(Adr%(39),Es_cn&)=Bset(Ob_state(Adr%(39),Es_cn&),0) Else Ob_state(Adr%(39),Es_cn&)=Bclr(Ob_state(Adr%(39),Es_cn&),0) Endif ' If Rmode! Ob_state(Adr%(39),Es_ro&)=Bset(Ob_state(Adr%(39),Es_ro&),0) Else Ob_state(Adr%(39),Es_ro&)=Bclr(Ob_state(Adr%(39),Es_ro&),0) Endif ' If Dmodet! Ob_state(Adr%(39),Es_d0&)=Bset(Ob_state(Adr%(39),Es_d0&),0) Else Ob_state(Adr%(39),Es_d0&)=Bclr(Ob_state(Adr%(39),Es_d0&),0) Endif ' If Dmodeg! Ob_state(Adr%(39),Es_d1&)=Bset(Ob_state(Adr%(39),Es_d1&),0) Else Ob_state(Adr%(39),Es_d1&)=Bclr(Ob_state(Adr%(39),Es_d1&),0) Endif ' Char{{Ob_spec(Adr%(39),Es_id&)}}=Id$ ' Redo!=True A&=Byte(@Form_wdo(39,0)) Ob_state(Adr%(39),A&)=Bclr(Ob_state(Adr%(39),A&),0) ~@Form_wdo(39,-3) ' If A&=Es_ok& If Btst(Ob_state(Adr%(39),Es_emu&),0) ! ‚muler Emul!=True Recept!=True Else if Btst(Ob_state(Adr%(39),Es_des&),0) ! dessiner Emul!=False Recept!=False Else if Btst(Ob_state(Adr%(39),Es_emr&),0) ! dessiner et recevoir Emul!=False Recept!=True Else if Btst(Ob_state(Adr%(39),Es_off&),0) ! off Emul!=True Recept!=False Endif ' If Btst(Ob_state(Adr%(39),Es_rep&),0) ! r‚ponse si demande status etc? Answer!=True Else Answer!=False Endif ' If Btst(Ob_state(Adr%(39),Es_cn&),0) Connect!=True Else Connect!=False Endif If Wopen!(4) @Wind_clip(4) Vdraw(F_c&,0) Endif ' If Btst(Ob_state(Adr%(39),Es_ro&),0) Rmode!=True Else Rmode!=False Endif ' If Btst(Ob_state(Adr%(39),Es_d0&),0) Dmodet!=True Else Dmodet!=False Endif ' If Btst(Ob_state(Adr%(39),Es_d1&),0) Dmodeg!=True Else Dmodeg!=False Endif ' Id$=Char{{Ob_spec(Adr%(39),Es_id&)}} ' Endif ' Case 177 ! Init If @Form_alert(1,"[3][|R‚Initialiser l'‚mulateur? |][Confirmer| Annuler ]")=1 Gosub Defmouse(2) Gosub Emul_uninit Gosub Emul_init ~Fre(0) ' ~Form_dial(3,0,0,0,0,W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) Rdw_all(4) Gosub Defmouse(0) Endif ' Case 52 Gosub Emulm(0) ' ~Form_dial(3,0,0,0,0,W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) Rdw_all(4) ' Case 56 Gosub Emulm(1) ' ~Form_dial(3,0,0,0,0,W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) Rdw_all(4) ' Case 146 ! cls ' Gosub Emulm(Emulm|) @Vcls(True) ' @Vcls_draw ' ~Form_dial(3,0,0,0,0,W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) Rdw_all(4) ' Case 152 ! curs on @Vcurs(False) Ncurs!=True @Vcurs(True) ' Case 153 ! curs off @Vcurs(False) Ncurs!=False ' Case 159 ! save page $S& Select @Form_alert(1,"[3][|Sauver page: |][Vid‚otext|Graphique| annuler ]") Case 1 @Save.pag Case 2 @Save.imgpag Endselect $S% ' Case 167 Gosub Emulcol Case 666 If Len(Col$)<>0 If @Form_alert(1,"[3][R‚glez les couleurs systŠme |voulues dans "+Name$+" |… l'aide de XCONTROL, puis |recliquez dans ce menu][Confirmer|Annuler]")=1 Clr Col$ Gosub Test_menu Endif Else if Len(Col$)=0 If @Form_alert(1,"[3][Les couleurs actuelles |doivent-elles ˆtre celles de |l'‚mulateur?][Confirmer|Annuler]")=1 Clr Col$ For A&=0 To Work_out(13)-1 Contrl(0)=26 Contrl(1)=0 Contrl(3)=2 Contrl(6)=V~h Intin(0)=A& Intin(1)=0 Vdisys Col$=Col$+Mki$(Intout(1))+Mki$(Intout(2))+Mki$(Intout(3)) Next A& Gosub Fmshow("Sauvegarde de la configuration couleur..") Gosub Defmouse(2) Open "O",#1,Set_path$+"SWVDI"+Hex$(Work_out(13),3)+".CNF" Print #1,Col$; Close #1 Gosub Defmouse(0) Gosub Fmhide Gosub Test_menu Endif Endif ' Case 82,114 ! R, redraw all Rdw_all(4) ' Case 187 To 196,5,12,19 Return False ' Case 999 Gosub Setfscreen(4) ! full screen Gosub Top(4) ' Default Return False Endselect $S% Endif ' ' Return True ' Endfunc Procedure Emclic(Mx&,My&,Mk&) Local E$,C$ Local X&,C& Local A&,B& ' @Wind_clip(4) Mx&=@Wxrcoord(4,Mx&)-Emx& My&=@Wyrcoord(4,My&)-Emy& Mx&=Mx&\Eccsizex& My&=My&\Eccsizey& ' If Mx&=>0 And My&=>0 And Mx&<=Vmax_x& And My&<=Vmax_y& If Not (Btst(Vida|(Mx&,My&),4) And Emulm|=0) ! <>graph ' Clr A&,B& If Btst(Vids&(Mx&,My&),8+2) ! lettre partie haute! Inc My& Endif If Not Btst(Vids&(Mx&,My&),8+3) ! partie gauche (dble taille=4 car) C&=Byte(Vids&(Mx&,My&)) $S& Select C& Case "'","`","_","ø",":","!",34,"#","[","]","(",")" E$=" " Case 33 To 122,128 To 255 E$=Chr$(C&) Default E$=" " Endselect $S% Endif If E$<>" " X&=Mx&-1 While X&=>0 Exit if (Btst(Vida|(X&,My&),4) And Emulm|=0) ! graphique!! If Not Btst(Vids&(X&,My&),8+3) ! partie gauche (dble taille=4 car) C&=Byte(Vids&(X&,My&)) $S& Select C& Case "'","`","_","ø",":","!",34,"#","[","]","(",")" Exit if True Case 33 To 122,128 To 255 E$=Chr$(C&)+E$ Default Exit if True Endselect $S% Endif Dec X& Inc A& Wend X&=Mx&+1 While X&<=Vmax_x& If Not Btst(Vids&(X&,My&),8+3) ! partie gauche (dble taille=4 car) C&=Byte(Vids&(X&,My&)) $S& Select C& Case "'","`","_","ø",":","!",34,"#","[","]","(",")" Exit if True Case 33 To 122,128 To 255 E$=E$+Chr$(C&) Default Exit if True Endselect $S% Endif Inc X& Inc B& Wend ' If E$<>" " Graphmode 3 @Lhidem Pbox @Wxacoord(4,(Mx&-A&)*Eccsizex&+Emx&),@Wyacoord(4,My&*Eccsizey&+Emy&),@Wxacoord(4,(Mx&+B&+1)*Eccsizex&+Emx&-1),@Wyacoord(4,(My&+1)*Eccsizey&+Emy&-1) @Lshowm Delay 0.1 @Lhidem Pbox @Wxacoord(4,(Mx&-A&)*Eccsizex&+Emx&),@Wyacoord(4,My&*Eccsizey&+Emy&),@Wxacoord(4,(Mx&+B&+1)*Eccsizex&+Emx&-1),@Wyacoord(4,(My&+1)*Eccsizey&+Emy&-1) @Lshowm Graphmode 1 ' C$=Upper$(E$) If C$="SOMMAIRE" Outvid(Sep$+"F") ~@Infow(4,"Sommaire") Else if C$="GUIDE" Outvid(Sep$+"D") ~@Infow(4,"Guide") Else if C$="SUITE" Outvid(Sep$+"H") ~@Infow(4,"Suite") Else if C$="RETOUR" Outvid(Sep$+"B") ~@Infow(4,"Retour") Else if C$="ANNULATION" Outvid(Sep$+"E") ~@Infow(4,"Annulation") Else if C$="CX/FIN" Or C$="CONNEXION/FIN" Or C$="CONNEXION" Outvid(Sep$+"I") ~@Infow(4,"Connexion/Fin") Else if C$="REPETITION" Or C$="RPTITION" Outvid(Sep$+"C") ~@Infow(4,"R‚p‚tition") Else if C$="ENVOI" Outvid(Sep$+"A") ~@Infow(4,"Envoi") Else if C$="CORRECTION" Outvid(Sep$+"G") ~@Infow(4,"Correction") ' Else If Len(E$)<=20 Outvid(E$+Sep$+"A") ~@Infow(4,( oÑüèpr&(ÿÿ (ÿÿ„gÄ„gÄ„gă+E$+"'") Else ~@Infow(4,"trop long..") Endif ' Endif Endif Endif Endif Endif ' Return ' Procedure Emulcol Local N&,X&,Y&,A&,M& ' ' Clip_off N&=0 ! noir Ob_state(Adr%(8),N&+3)=Bset(Ob_state(Adr%(8),N&+3),4) Exdo!=True Do ' ' Dessiner arbre ~@Form_exdo(8,-2) ' Couleurs texte ' Word{Ob_spec(Adr%(8),25)+18}=Or(And(Word{Ob_spec(Adr%(8),25)+18},&X1111000011111111),Shl(Tcol&(N&,0),8)) ' Word{Ob_spec(Adr%(8),44)+18}=Or(And(Word{Ob_spec(Adr%(8),44)+18},&X1111000011111111),Shl(Tcol&(N&,1),8)) If Not Exdo! ' ~Objc_draw(Adr%(8),25,255,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) ' ~Objc_draw(Adr%(8),44,255,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) Endif ' Clignotant? If Tcof!(N&) Ob_state(Adr%(8),Ec_cli&)=Bset(Ob_state(Adr%(8),Ec_cli&),0) Else Ob_state(Adr%(8),Ec_cli&)=Bclr(Ob_state(Adr%(8),Ec_cli&),0) Endif If Not Exdo! ~Objc_draw(Adr%(8),Ec_cli&,255,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) Endif If Not Exdo! ' Desiner objet @Hidem ~Objc_offset(Adr%(8),Ec_box&,X&,Y&) Gosub Deffill(Fcol&(N&),Fstyl|(N&),Findex|(N&)) Gosub Pbox(X&,Y&,X&+Ob_w(Adr%(8),Ec_box&)-1,Y&+Ob_h(Adr%(8),Ec_box&)-1) ' ~Objc_offset(Adr%(8),Ec_bn&,X&,Y&) Gosub Deffill(Tcol&(N&,0),1,1) Gosub Pbox(X&,Y&,X&+Ob_w(Adr%(8),Ec_bn&)-1,Y&+Ob_h(Adr%(8),Ec_bn&)-1) ' ~Objc_offset(Adr%(8),Ec_bc&,X&,Y&) Gosub Deffill(Tcol&(N&,1),1,1) Gosub Pbox(X&,Y&,X&+Ob_w(Adr%(8),Ec_bc&)-1,Y&+Ob_h(Adr%(8),Ec_bc&)-1) @Showm Endif ' M&=@Form_exdo(8,0) A&=Byte(M&) ' ~Objc_change(Adr%(8),A&,0,Rx&(8),Ry&(8),Rw&(8),Rh&(8),Bclr(Ob_state(Adr%(8),A&),0),1) ' If Btst(Ob_state(Adr%(8),Ec_cli&),0) If Tcol&(N&,1)=>4 ! interdit (flash d‚sagr‚able sous bureau!) Tcof!(N&)=True Else Tcof!(N&)=False Endif Else Tcof!(N&)=False Endif ' $S& Select A& ' Case Ec_text& ' ~form_dial(3,0,0,0,0,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) ~@Form_exdo(8,-3) Select_text(True) Exdo!=True ' Case Ec_c0& To Ec_c7& Ob_state(Adr%(8),N&+Ec_c0&)=Bclr(Ob_state(Adr%(8),N&+Ec_c0&),4) N&=A&-Ec_c0& Ob_state(Adr%(8),A&)=Bset(Ob_state(Adr%(8),A&),4) ~Objc_draw(Adr%(8),Ec_cbox&,255,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) ' Case Ec_bn& ! barre select ' ~form_dial(3,0,0,0,0,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) ~@Form_exdo(8,-3) Tcol&(N&,0)=@Pannel(Tcol&(N&,0)) Case Ec_bc& ! barre select ' ~form_dial(3,0,0,0,0,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) ~@Form_exdo(8,-3) Tcol&(N&,1)=@Pannel(Tcol&(N&,1)) ' Case Ec_tnp& ! +txt norm If Not Btst(M&,15) Add Tcol&(N&,0),1 If Work_out(13)>0 Tcol&(N&,0)=Min(Work_out(13)-1,Tcol&(N&,0)) Endif Else ' ~form_dial(3,0,0,0,0,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) ~@Form_exdo(8,-3) Tcol&(N&,0)=@Pannel(Tcol&(N&,0)) Endif Case Ec_tnm& ! -txt norm If Not Btst(M&,15) Sub Tcol&(N&,0),1 Tcol&(N&,0)=Max(0,Tcol&(N&,0)) Else ' ~form_dial(3,0,0,0,0,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) ~@Form_exdo(8,-3) Tcol&(N&,0)=@Pannel(Tcol&(N&,0)) Endif Case Ec_tfp& ! +txt flash If Not Btst(M&,15) Add Tcol&(N&,1),1 If Work_out(13)>0 Tcol&(N&,1)=Min(Work_out(13)-1,Tcol&(N&,1)) Endif Else ' ~form_dial(3,0,0,0,0,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) ~@Form_exdo(8,-3) Tcol&(N&,1)=@Pannel(Tcol&(N&,1)) Endif Case Ec_tfm& ! -txt flash If Not Btst(M&,15) Sub Tcol&(N&,1),1 Tcol&(N&,1)=Max(0,Tcol&(N&,1)) Else ' ~form_dial(3,0,0,0,0,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) ~@Form_exdo(8,-3) Tcol&(N&,1)=@Pannel(Tcol&(N&,1)) Endif Case Ec_bp& ! +col If Not Btst(M&,15) Add Fcol&(N&),1 If Work_out(13)>0 Fcol&(N&)=Min(Work_out(13)-1,Fcol&(N&)) Endif Else ' ~form_dial(3,0,0,0,0,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) ~@Form_exdo(8,-3) Fcol&(N&)=@Pannel(Fcol&(N&)) Endif Case Ec_bm& ! -col If Not Btst(M&,15) Sub Fcol&(N&),1 Fcol&(N&)=Max(0,Fcol&(N&)) Else ' ~form_dial(3,0,0,0,0,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) ~@Form_exdo(8,-3) Fcol&(N&)=@Pannel(Fcol&(N&)) Endif Case Ec_stp& ! +styl Fstyl|(N&)=Min(3,Fstyl|(N&)+1) Case Ec_stm& ! -styl Fstyl|(N&)=Max(2,Fstyl|(N&)-1) Case Ec_idp& ! +index Findex|(N&)=Min(24,Findex|(N&)+1) Case Ec_idm& ! -index Findex|(N&)=Max(0,Findex|(N&)-1) ' Case Ec_ok&,0,1 Exit if True Case Ec_save& Gosub Save_col ' Case Ec_box& ! Select style+motif ' 1 to 36= 36 motifs+styles ' ~Objc_draw(Adr%(9),0,255,Rx&(9),Ry&(9),Rw&(9),Rh&(9)) ~@Form_exdo(8,-3) ~@Form_exdo(9,-2) @Hidem For A&=1 To 24 Gosub Deffill(Fcol&(N&),2,A&) ~Objc_offset(Adr%(9),A&,X&,Y&) Gosub Pbox(X&,Y&,X&+Ob_w(Adr%(9),A&)-1,Y&+Ob_h(Adr%(9),A&)-1) Next A& Gosub Deffill(Fcol&(N&),1,1) ~Objc_offset(Adr%(9),8,X&,Y&) Gosub Pbox(X&,Y&,X&+Ob_w(Adr%(9),8)-1,Y&+Ob_h(Adr%(9),8)-1) For A&=1 To 12 Gosub Deffill(Fcol&(N&),3,A&) ~Objc_offset(Adr%(9),A&+24,X&,Y&) Gosub Pbox(X&,Y&,X&+Ob_w(Adr%(9),A&+24)-1,Y&+Ob_h(Adr%(9),A&+24)-1) Next A& @Showm ' ' ~@Wind_update01(1) A&=Byte(@Form_exdo(9,999)) ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(9),Ry&(9),Rw&(9),Rh&(9)) ~@Form_exdo(9,-3) Gosub W_rdexe ~@Wind_update01(1) Select A& Case 8 ! Deffill ,1,1 Fstyl|(N&)=1 Findex|(N&)=1 Case 1 To 24 Fstyl|(N&)=2 Findex|(N&)=A& Case 25 To 36 Fstyl|(N&)=3 Findex|(N&)=A&-24 Endselect ~@Form_exdo(8,-2) ' ~Objc_draw(Adr%(8),0,255,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) ' Endselect $S% ' If N&=0 ! fond, modif interdite ' Tcol&(0,0)=0 ' Tcol&(0,1)=0 ' Endif ' Loop Ob_state(Adr%(8),N&+Ec_c0&)=Bclr(Ob_state(Adr%(8),N&+Ec_c0&),4) Gosub Defmouse(2) Gosub Cache_uninit Gosub Cache_init Gosub Defmouse(0) ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(8),Ry&(8),Rw&(8),Rh&(8)) ~@Form_exdo(8,-3) @W_rdexe If Wopen!(4) Rdw_all(4) Endif ' Return ' Function Pannel(N&) $F% Local A&,M&,X&,Y&,S& ' ~@Wind_update01(0) @W_rdexe ~@Wind_update01(1) ' ~Objc_draw(Adr%(26),0,255,Rx&(26),Ry&(26),Rw&(26),Rh&(26)) ~@Form_exdo(26,-2) ' M&=Em_p1&+9 S&=Max(0,Min(N&,Work_out(13)-10)) ! Inc Gosub Defmouse(3) Do @Hidem For A&=0 To 9 ~Objc_offset(Adr%(26),Em_p1&+A&,X&,Y&) If A&0 S&=Max(0,Min(Work_out(13)-10,S&+1)) Else S&=Min(S&+1,&HFFFF) Endif Case Em_pm& S&=Max(0,S&-1) Case Em_p1& To M& N&=(A&-Em_p1&)+S& Exit if True Case Em_pc&,0 Ob_state(Adr%(26),A&)=Bclr(Ob_state(Adr%(26),A&),0) Exit if True Case Em_sl& X&=Graf_slidebox(Adr%(26),Em_bs&,Em_sl&,1) ! g‚rer slide S&=(Work_out(13)*X&)\1000 Case Em_bs& Mouse X&,Y&,A& ~Objc_offset(Adr%(26),Em_sl&,X&,A&) If Y&0 S&=Max(0,Min(Work_out(13)-10,S&+9)) Else S&=Min(S&+9,&HFFFF) Endif Endif Endselect Loop Gosub Defmouse(0) ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(26),Ry&(26),Rw&(26),Rh&(26)) ~@Form_exdo(26,-3) Exdo!=True @W_rdexe ' Return N& Endfunc ' Procedure Flash Local A%,B%,C%,X%,T% ' If @Firstw<>-1 ! 1 fenˆtre en 1e plan? Contrl(0)=26 ! inquire color index Contrl(1)=0 Contrl(3)=2 Contrl(6)=V~h Intin(0)=0 Intin(1)=0 Vdisys A%=Intout(1) ! color 0 ; R,G,B B%=Intout(2) C%=Intout(3) ' For X%=0 To 7 If Tcof!(X%) ! flash!! Contrl(0)=26 ! inquire color index Contrl(1)=0 Contrl(3)=2 Contrl(6)=V~h Intin(0)=Tcol&(X%,1) Intin(1)=0 Vdisys Flasher&(X%,0)=Intout(1) Flasher&(X%,1)=Intout(2) Flasher&(X%,2)=Intout(3) ' Contrl(0)=14 ! set vdi color Contrl(1)=0 Contrl(3)=4 Contrl(6)=V~h Intin(0)=Tcol&(X%,1) Intin(1)=A% Intin(2)=B% Intin(3)=C% Vdisys Endif Next X% ' If Recept! ! mode r‚ception? T%=@Wtestop(4) ! ‚mul en 1e plan? If Not T% T%=@W_tstview(4) ! mais voit-on la fenˆtre totalement? Endif If T% @Vcurs(False) ' Clip_off Wind_clip(4) Gosub Tmanage(True) ! tester ‚mulateur Else Part_draw(0) ' Clip_off Wind_clip(4) Gosub Tmanage(False) ! tester ‚mulateur Endif ~Evnt_timer(100) @Hidem If T% @Vcurs(True) Else Part_draw(1) Endif @Showm ' Else ! mode DRAW! ~Evnt_timer(100) Endif ' For X%=0 To 7 If Tcof!(X%) ! flash!! Contrl(0)=14 ! set vdi color Contrl(1)=0 Contrl(3)=4 Contrl(6)=V~h Intin(0)=Tcol&(X%,1) Intin(1)=Flasher&(X%,0) Intin(2)=Flasher&(X%,1) Intin(3)=Flasher&(X%,2) Vdisys Endif Next X% Endif ' Return ' ' ' ' /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ ' Emulateur DRCS Sweetel 2.0 - ½1993 Xavier ROCHE ' /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ ' Gestion du DRCS ' /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ ' ' Init/Uninit Procedure Drcs_init Local E| Local E$,A$ Local A&,E%,D%,T& ' Dim Mfdb1&(9) ! premiŠre structure MFDB Dim Mfdb2&(9) ! seconde structure MFDB ' ' DRCS init ' ' 2 jeux de 94 (128-33-1) caractŠres de 10 pixels de haut et de 8 bits de large Dim Drcs|(1,93,9) Arrayfill Drcs|(),0 Dim Keep|(94*2-1) Arrayfill Keep|(),0 ' Jeu r‚serv‚ … l'‚mulateur! Dim Edrcs|(1,93,9) Arrayfill Edrcs|(),0 ' E$=Set_path$+"AUTO.SFD" If Not @Fexist(E$) E$="FONTES\AUTO.SFD" ~@Fexist(E$) Endif If @Exist(E$) Gosub Defmouse(2) Open "I",#1,E$ If Lof(#1)>8 If Input$(8,#1)="SWT2DRCS" Clr T& While Not Eof(#1) E%=Inp(#1) D%=Inp(#1) A$=Input$(10,#1) If E%=>0 And D%=>0 And E%<=1 And D%<=93 For A&=0 To 9 Edrcs|(E%,D%,A&)=Asc(Mid$(A$,A&+1,1)) Next A& Inc T& Endif Wend Else ~@Form_alert(1,@Errf$(35)) Endif Else ~@Form_alert(1,@Errf$(35)) Endif Close #1 Gosub Defmouse(0) Endif ' Return Procedure Drcs_uninit Erase Drcs|() Erase Keep|() Erase Edrcs|() Erase Mfdb1&(),Mfdb2&() Return ' ' Redessiner fenˆtre DRCS! Procedure Drcs_draw(X%,Y%,W%,H%) Local A%,B%,C%,D%,E%,X2%,Y2%,X3%,Y3%,W3%,H3% ' @Hidem @Clip(X%,Y%,W%,H%) X2%=@Wxacoord(5,Drs_x&) Y2%=@Wyacoord(5,Drs_y&) Gosub Deffillcol(0) Gosub Pbox(X%,Y%,X%+W%-1,Y%+H%-1) ' Box X2%-5,Y2%-5,X2%+47*12+7,Y2%+4*14+5 ' Box X2%-3,Y2%-3,X2%+47*12+5,Y2%+4*14+3 ' Box X2%-2,Y2%-2,X2%+47*12+4,Y2%+4*14+2 ' Box X2%-2,Y2%-2,X2%+47*12+4,Y2%+2*14-2 @Gbox(X2%,Y2%,X2%+47*12,Y2%+4*14) Gosub Color(1) Gosub Line(X2%,Y2%+2*14-2,X2%+47*$ And And And And Eqv Xor +4,Y2%+2*14-2) Gosub Color(Col1&) ' For E%=0 To 1 For D%=0 To 1 For C%=0 To 46 ' X3%=X2%+C%*12 ! localisation Y3%=Y2%+D%*14+E%*28 W3%=8 H3%=10 ' If Rc_intersect(X%,Y%,W%,H%,X3%,Y3%,W3%,H3%) For B%=0 To 9 $S& Select Drcs|(E%,C%+D%*47,B%) Case 0 Case &HFF Gosub Line(X2%+C%*12,Y2%+D%*14+E%*28+B%,X2%+C%*12+7,Y2%+D%*14+E%*28+B%) Default For A%=0 To 7 If Btst(Drcs|(E%,C%+D%*47,B%),7-A%) Plot X2%+C%*12+A%,Y2%+B%+D%*14+E%*28 Endif Next A% Endselect $S% Next B% Endif Next C% Next D% Next E% @Showm ' Return ' ' ' Selection souris: bouton 1 Procedure Drcs_sel(Mx&,My&) Local B%,C%,E%,C2%,E2% Local Flag!,X%,Y%,P% ! col Local X2%,Y2%,W2%,H2% Local N%,N& Local E$ ! sauvegarder char ' @Clip(W_ix&(5),W_iy&(5),W_iw&(5),W_ih&(5)) Gosub Drcs_vw(Mx&,My&) ! montrer char en info ' Mx&=@Wxrcoord(5,Mx&)-Drs_x& My&=@Wyrcoord(5,My&)-Drs_y& Mx&=Min(Max(0,Mul(Div(Mx&,12),12)),46*12) My&=Min(Max(0,Mul(Div(My&,14),14)),3*14) C%=Mx&\12+(Mod(My&,28)\14)*47 ! Et pos E%=My&\28 ' X2%=Mx& Y2%=My& ' ' ~Graf_dragbox(8,10,@Wxacoord(5,Mx&+Drs_x&),@Wyacoord(5,My&+Drs_y&),W_ix&(5),W_iy&(5),W_iw&(5),W_ih&(5),X2%,Y2%) Clr X%,Y% Graphmode (3) Gosub Pbox(@Wxacoord(5,X%+Drs_x&),@Wyacoord(5,Y%+Drs_y&),@Wxacoord(5,X%+Drs_x&)+7,@Wyacoord(5,Y%+Drs_y&)+9) Do Mouse X2%,Y2%,P% @Hidem Gosub Box(X2%,Y2%,X2%+7,Y2%+9) Gosub Box(X2%,Y2%,X2%+7,Y2%+9) X2%=@Wxrcoord(5,X2%)-Drs_x& ! calculer coords Y2%=@Wyrcoord(5,Y2%)-Drs_y& X2%=Min(Max(0,Mul(Div(X2%,12),12)),46*12) Y2%=Min(Max(0,Mul(Div(Y2%,14),14)),3*14) If X%<>X2% Or Y%<>Y2% Gosub Pbox(@Wxacoord(5,X%+Drs_x&),@Wyacoord(5,Y%+Drs_y&),@Wxacoord(5,X%+Drs_x&)+7,@Wyacoord(5,Y%+Drs_y&)+9) Gosub Pbox(@Wxacoord(5,X2%+Drs_x&),@Wyacoord(5,Y2%+Drs_y&),@Wxacoord(5,X2%+Drs_x&)+7,@Wyacoord(5,Y2%+Drs_y&)+9) X%=X2% Y%=Y2% Endif @Showm Loop until P%<>1 Graphmode (1) ' C2%=X2%\12+(Mod(Y2%,28)\14)*47 E2%=Y2%\28 ' If P%=0 If C%<>C2% Or E%<>E2% ' If And(@Shift,&X11)<>0 ! Copier Flag!=True Else Flag!=False ! Echanger Endif ' For Y%=0 To 9 If Flag! Drcs|(E2%,C2%,Y%)=Drcs|(E%,C%,Y%) Else Swap Drcs|(E2%,C2%,Y%),Drcs|(E%,C%,Y%) Endif Next Y% ' @Hidem @Wmove(@Wxacoord(5,Mx&+Drs_x&),@Wyacoord(5,My&+Drs_y&),8,10,@Wxacoord(5,X2%+Drs_x&),@Wyacoord(5,Y2%+Drs_y&),8,10) Gosub Drcs_draw(@Wxacoord(5,X2%+Drs_x&),@Wyacoord(5,Y2%+Drs_y&),8,10) If Not Flag! @Wmove(@Wxacoord(5,X2%+Drs_x&),@Wyacoord(5,Y2%+Drs_y&),8,10,@Wxacoord(5,Mx&+Drs_x&),@Wyacoord(5,My&+Drs_y&),8,10) Gosub Drcs_draw(@Wxacoord(5,Mx&+Drs_x&),@Wyacoord(5,My&+Drs_y&),8,10) Endif @Showm ' Else ' M coord, ‚diter! ' If Mx&=>0 And My&=>0 And Mx&<=12*$ And And And And Eqv Eqv And My&<=4*14 ' ' B%=Mod(My&,14) ' A%=Mod(Mx&,12) ' If E%=>0 And C%=>0 And E%<=1 And C%<=93 ' Char{{Ob_spec(Adr%(16),Dr_char&)}}=Chr$(C%+33) Exdo!=True Do ' Sauver char (cancel) Clr E$ For Y%=0 To 9 E$=E$+Chr$(Drcs|(E%,C%,Y%)) Next Y% ' Gosub Defmouse(2) Gosub Drsdraw(E%,C%) Gosub Defmouse(0) ' If Not Exdo! Char{{Ob_spec(Adr%(16),Dr_char&)}}=Chr$(C%+33) ~Objc_draw(Adr%(16),Dr_char&,&HFF,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) Endif Edited!(2)=True Do N%=@Form_wdo(16,0) N&=Byte(N%) If N&Dr_last& ~Objc_change(Adr%(16),N&,0,Rx&(16),Ry&(16),Rw&(16),Rh&(16),Bclr(Ob_state(Adr%(16),N&),0),1) Endif ' $S& Select N& Case Dr_first& To Dr_last& If Not Btst(Ob_state(Adr%(16),N&),0) Flag!=True Else Flag!=False Endif ~Objc_offset(Adr%(16),Dr_cadr&,X2%,Y2%) W2%=Ob_w(Adr%(16),Dr_first&) H2%=Ob_h(Adr%(16),Dr_first&) Gosub Defmouse(3) Repeat Mouse X%,Y%,P% X%=(X%-X2%)\W2% Y%=(Y%-Y2%)\H2% If X%=>0 And Y%=>0 And X%<=7 And Y%<=9 If Flag! Drcs|(E%,C%,Y%)=Bset(Drcs|(E%,C%,Y%),7-X%) ~Objc_change(Adr%(16),Dr_first&+X%+Y%*8,0,Rx&(16),Ry&(16),Rw&(16),Rh&(16),Bset(Ob_state(Adr%(16),Dr_first&+X%+Y%*8),0),1) Else Drcs|(E%,C%,Y%)=Bclr(Drcs|(E%,C%,Y%),7-X%) ~Objc_change(Adr%(16),Dr_first&+X%+Y%*8,0,Rx&(16),Ry&(16),Rw&(16),Rh&(16),Bclr(Ob_state(Adr%(16),Dr_first&+X%+Y%*8),0),1) Endif Endif Until P%=0 Gosub Defmouse(0) ' ~Form_dial(3,0,0,0,0,@Wxacoord(5,(Mx&\12)*12+Drs_x&),@Wyacoord(5,(My&\14)*14+Drs_y&),12,14) Gosub Chardraw(Mx&,My&) ' Case Dr_eff& For B%=0 To 9 Drcs|(E%,C%,B%)=&X0 Next B% Gosub Drsdraw(E%,C%) ' ~Form_dial(3,0,0,0,0,@Wxacoord(5,(Mx&\12)*12+Drs_x&),@Wyacoord(5,(My&\14)*14+Drs_y&),12,14) Gosub Chardraw(Mx&,My&) ~Objc_draw(Adr%(16),Dr_cadr&,&HFF,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) ' Case Dr_fill& For B%=0 To 9 Drcs|(E%,C%,B%)=&HFF Next B% Gosub Drsdraw(E%,C%) ' ~Form_dial(3,0,0,0,0,@Wxacoord(5,(Mx&\12)*12+Drs_x&),@Wyacoord(5,(My&\14)*14+Drs_y&),12,14) Gosub Chardraw(Mx&,My&) ~Objc_draw(Adr%(16),Dr_cadr&,&HFF,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) ' Case Dr_hflip& Gosub Drhflip(E%,C%) ' Gosub Drsdraw(E%,C%) Gosub Chardraw(Mx&,My&) ~Objc_draw(Adr%(16),Dr_cadr&,&HFF,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) ' Case Dr_vflip& Gosub Drvflip(E%,C%) ' Gosub Drsdraw(E%,C%) Gosub Chardraw(Mx&,My&) ~Objc_draw(Adr%(16),Dr_cadr&,&HFF,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) ' Case Dr_inv& For B%=0 To 9 Drcs|(E%,C%,B%)=Byte(Not Drcs|(E%,C%,B%)) Next B% Gosub Drsdraw(E%,C%) ' ~Form_dial(3,0,0,0,0,@Wxacoord(5,(Mx&\12)*12+Drs_x&),@Wyacoord(5,(My&\14)*14+Drs_y&),12,14) Gosub Chardraw(Mx&,My&) ~Objc_draw(Adr%(16),Dr_cadr&,&HFF,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) ' Case Dr_h& ' If Btst(N%,15)=False Gosub Drmov_h(E%,C%) Else Gosub Dr_centr(E%,C%,1) Endif Gosub Drsdraw(E%,C%) Gosub Chardraw(Mx&,My&) ~Objc_draw(Adr%(16),Dr_cadr&,&HFF,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) Case Dr_b& If Btst(N%,15)=False Gosub Drmov_b(E%,C%) Else Gosub Dr_centr(E%,C%,2) Endif Gosub Drsdraw(E%,C%) Gosub Chardraw(Mx&,My&) ~Objc_draw(Adr%(16),Dr_cadr&,&HFF,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) Case Dr_g& If Btst(N%,15)=False Gosub Drmov_g(E%,C%) Else Gosub Dr_centr(E%,C%,3) Endif Gosub Drsdraw(E%,C%) Gosub Chardraw(Mx&,My&) ~Objc_draw(Adr%(16),Dr_cadr&,&HFF,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) Case Dr_d& If Btst(N%,15)=False Gosub Drmov_d(E%,C%) Else Gosub Dr_centr(E%,C%,4) Endif Gosub Drsdraw(E%,C%) Gosub Chardraw(Mx&,My&) ~Objc_draw(Adr%(16),Dr_cadr&,&HFF,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) ' Case Dr_load& ~@Wind_update01(0) Exdo!=True ' ~form_dial(3,0,0,0,0,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) ~@Form_wdo(16,-3) File$(7)=@Fsel$("\*.SFC",File$(7),"Charger 1 caractŠre") @W_rdexe If Len(File$(7))>0 If @Exist(File$(7)) Gosub Defmouse(2) Open "I",#1,File$(7) If Lof(#1)=10 For B%=0 To 9 Drcs|(E%,C%,B%)=Inp(#1) Next B% ~@Infow(5,"1 caractŠre charg‚") Gosub Drsdraw(E%,C%) Gosub Chardraw(Mx&,My&) Else ~@Form_alert(1,@Errf$(35)) Endif Close #1 Gosub Defmouse(0) Else ~@Form_alert(1,@Errf$(-33)) Endif Endif ~@Wind_update01(1) Case Dr_save& ~@Wind_update01(0) Exdo!=True ' ~form_dial(3,0,0,0,0,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) ~@Form_wdo(16,-3) File$(7)=@Fsel$("\*.SFC",File$(7),"Sauver 1 caractŠre") @W_rdexe If Len(File$(7))>0 If @Exist(File$(7)) If @Form_alert(2,"[3][|"+"Ce fichier existe d‚j…, |l'effacer? ][ Confirmer| Annuler ]")<>1 File$(7)="" Else If Not @Back(File$(7)) ! erreur File$(7)="" Endif Endif Endif If Len(File$(7))>0 Open "O",#1,File$(7) Gosub Defmouse(2) For B%=0 To 9 Print #1,Chr$(Drcs|(E%,C%,B%)); Next B% Close #1 Gosub Defmouse(0) ~@Infow(5,"1 caractŠre sauv‚") Endif Endif ~@Wind_update01(1) ' Case Dr_ok&,0 ' ' ' Et quitter! Exit if True Case Dr_cancel&,1 For Y%=0 To 9 Drcs|(E%,C%,Y%)=Asc(Mid$(E$,Y%+1,1)) Next Y% Gosub Drsdraw(E%,C%) Gosub Chardraw(Mx&,My&) ~Objc_draw(Adr%(16),Dr_cadr&,&HFF,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) ' Case Dr_next& Gosub Chardraw(Mx&,My&) Exit if True Endselect $S% Loop ' If N&=Dr_next& Inc C% If C%>93 Clr C% Inc E% If E%>1 Clr E% Endif Endif ' Mx&=@Wxacoord(5,Mod(C%,47)*12+Drs_x&) Mx&=Mod(C%,47)*12 My&=Div(C%,47)*14 ' My&=@Wyacoord(5,Div(C%,47)*14+Drs_y&) Gosub Drsdraw(E%,C%) ~Objc_draw(Adr%(16),Dr_cadr&,&HFF,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) Else N&=-1 Endif ' Loop until N&=-1 ~@Wind_update01(0) ' ~Form_dial(3,0,0,0,0,@Wxacoord(5,(Mx&\12)*12+Drs_x&),@Wyacoord(5,(My&\14)*14+Drs_y&),12,14) Gosub Chardraw(Mx&,My&) ' ~form_dial(3,0,0,0,0,Rx&(16),Ry&(16),Rw&(16),Rh&(16)) ~@Form_wdo(16,-3) ' Else Gosub Xpoint(@Wxacoord(5,Mx&)+Drs_x&,@Wyacoord(5,My&)+Drs_y&) Endif Else Gosub Xpoint(@Wxacoord(5,Mx&)+Drs_x&,@Wyacoord(5,My&)+Drs_y&) Endif ' Endif ! copier ou ‚diter? Endif ! annul‚? ' @Caremouse ! ‡!'(Ý de GEM Return ' ' Sous-proc interne a /\ Procedure Chardraw(Mx&,My&) Local X&,Y&,W&,H& ' X&=@Wxacoord(5,(Mx&\12)*12+Drs_x&) Y&=@Wyacoord(5,(My&\14)*14+Drs_y&) W&=12 H&=14 If Rc_intersect(W_ix&(5),W_iy&(5),W_iw&(5),W_ih&(5),X&,Y&,W&,H&) @Clip(X&,Y&,W&,H&) If Not Rc_intersect(Rx&(16),Ry&(16),Rw&(16),Rh&(16),X&,Y&,W&,H&) X&=@Wxacoord(5,(Mx&\12)*12+Drs_x&) Y&=@Wyacoord(5,(My&\14)*14+Drs_y&) W&=12 H&=14 Drcs_draw(X&,Y&,W&,H&) Endif Endif @Clip_off Return ' ' Flip V/H Procedure Drvflip(E&,C&) Local E|,A& Local E$ ' Edited!(2)=True Clr E$ For E|=0 To 9 For A&=0 To 7 E$=E$+Chr$(48-Btst(Drcs|(E&,C&,E|),A&)) Next A& Next E| For E|=0 To 9 Drcs|(E&,C&,E|)=Val("&X"+Mid$(E$,E|*8+1,8)) Next E| ' Return Procedure Drhflip(E&,C&) Local E2&,A& Local E$ ' Edited!(2)=True Clr E$ ' ' **Attention!! E2& car E| ne peut ˆtre ‚gal … -1 ! (to 0 -> -1 … le fin!!!)** For E2&=9 Downto 0 E$=E$+Bin$(Drcs|(E&,C&,E2&),8) Next E2& For E2&=0 To 9 Drcs|(E&,C&,E2&)=Val("&X"+Mid$(E$,E2&*8+1,8)) Next E2& ' Return ' ' X-Move Procedure Drmov_h(E&,C&) Local N&,E| ' Edited!(2)=True N&=Drcs|(E&,C&,0) For E|=0 To 8 Drcs|(E&,C&,E|)=Drcs|(E&,C&,E|+1) Next E| Drcs|(E&,C&,9)=N& ' Return Procedure Drmov_b(E&,C&) Local N&,E2& ' Edited!(2)=True N&=Drcs|(E&,C&,9) For E2&=9 Downto 1 Drcs|(E&,C&,E2&)=Drcs|(E&,C&,E2&-1) Next E2& Drcs|(E&,C&,0)=N& ' Return Procedure Drmov_g(E&,C&) Local E| ' Edited!(2)=True For E|=0 To 9 If Btst(Drcs|(E&,C&,E|),7) Drcs|(E&,C&,E|)=Bset(Byte(Rol(Drcs|(E&,C&,E|),1)),0) Else Drcs|(E&,C&,E|)=Bclr(Byte(Rol(Drcs|(E&,C&,E|),1)),0) Endif Next E| ' Return Procedure Drmov_d(E&,C&) Local E| ' Edited!(2)=True For E|=0 To 9 If Btst(Drcs|(E&,C&,E|),0) Drcs|(E&,C&,E|)=Bset(Byte(Ror(Drcs|(E&,C&,E|),1)),7) Else Drcs|(E&,C&,E|)=Bclr(Byte(Ror(Drcs|(E&,C&,E|),1)),7) Endif Next E| ' Return ' ' X-Centr Procedure Dr_centr(E&,C&,Index&) Local E| Local X&,Y&,X2&,Y2&,W&,H& ' Edited!(2)=True Gosub Defmouse(2) For Y&=0 To 9 If Drcs|(E&,C&,Y&)<>0 Exit if True Endif Next Y& Y&=Min(Y&,9) For Y2&=9 Downto 0 If Drcs|(E&,C&,Y2&)<>0 Exit if True Endif Next Y2& Y2&=Max(Y2&,0) For X&=0 To 7 For E|=0 To 9 If Btst(Drcs|(E&,C&,E|),X&) Exit if True Endif Next E| If E|<>10 Exit if True Endif Next X& X&=Min(X&,7) For X2&=7 Downto 0 For E|=0 To 9 If Btst(Drcs|(E&,C&,E|),X2&) Exit if True Endif Next E| If E|<>10 Exit if True Endif Next X2& X2&=Max(X2&,7) W&=X2&-X&+1 H&=Y2&-Y&+1 ' X2&=(8-W&)\2 If Mod(8-W&,2)<>0 If Index&=4 Inc X2& Endif Endif ' Y2&=(10-H&)\2 If Mod(10-H&,2)<>0 If Index&=2 Inc Y2& Endif Endif ' X2&=X2&-X& Y2&=Y2&-Y& ' If X2&>0 For W&=1 To X2& Drmov_d(E&,C&) Next W& Else if X2&<0 For W&=1 To -X2& Drmov_g(E&,C&) Next W& Endif ' If Y2&>0 For H&=1 To Y2& Drmov_b(E&,C&) Next H& Else if Y2&<0 For H&=1 To -Y2& Drmov_h(E&,C&) Next H& Endif ' Gosub Defmouse(0) ' Return ' ' ' S‚lection souris sur caractŠre (bouton 2) Procedure Drcs_char(Mx&,My&) Local A&,B&,C& Local A! ' Exdo!=True If Drcs! Ob_state(Adr%(38),Drb_c&)=Bset(Ob_state(Adr%(38),Drb_c&),0) Else Ob_state(Adr%(38),Drb_c&)=Bclr(Ob_state(Adr%(38),Drb_c&),0) Endif A&=Byte(@Form_wdo(38,0)) Ob_state(Adr%(38),A&)=Bclr(Ob_state(Adr%(38),A&),0) ~@Form_wdo(38,-3) If Btst(Ob_state(Adr%(38),Drb_c&),0) Drcs!=True Else Drcs!=False Endif ' $S& Select A& Case Drb_l& ! load A!=(@Form_alert(1,"[3][|Voulez-vous charger TOUS |les caractŠres? |][ Oui |S‚lection]")=2) @Load.sfd(A!) Case Drb_s& ! save A!=(@Form_alert(1,"[3][|Voulez-vous sauver TOUS |les caractŠres? |][ Oui |S‚lection]")=2) @Save.sfd(A!) Case Drb_i& ! import @Import.sfd Case Drb_x& ! export A!=(@Form_alert(1,"[3][|Voulez-vous sauver TOUS |les caractŠres? |][ Oui |S‚lection]")=2) @Save.sfv(A!) Case Drb_e& ! effacer @Clr_jeu Case Drb_t& ! transfert Exdo!=True A&=Byte(@Form_wdo(37,0)) Ob_state(Adr%(37),A&)=Bclr(Ob_state(Adr%(37),A&),0) ~@Form_wdo(37,-3) ' $S& Select A& Case Drmok& ! 1:vdt->drcs Gosub Defmouse(2) ' A!=Btst(Ob_state(Adr%(37),Drm1&),0) A!=(@State_pop(Adr%(37),Drm10&)=1) If Not A! @Top(4) Endif For A&=0 To 1 For B&=0 To 93 For C&=0 To 9 If A! Drcs|(A&,B&,C&)=Edrcs|(A&,B&,C&) Else Edrcs|(A&,B&,C&)=Drcs|(A&,B&,C&) Endif Next C& ' If Not A! ' Ici on efface tous les caractŠres 'B&' du cache.. Clr Pc_a& Do ' Recherche: 3 objets, 3 adresses, max_obj (index), from (index) Pc_a&=C:Swchar%(W:B&+33,W:0,W:Y&,L:V:Cachs&(0),L:V:Cachc&(0),L:V:Cacha|(0),W:Ncach&,W:Pc_a&) If Pc_a&=>0 Cachs&(Pc_a&)=0 ! effacer!! Cacha|(Pc_a&)=0 Endif Inc Pc_a& Loop until Pc_a&<=0 Or Pc_a&>Ncach& ' If Wopen!(4) Gosub Vdt_reac(A&,B&,True) Endif Endif ' Next B& Next A& Gosub Defmouse(0) ' Endselect $S% If A! Rdw_all(5) Endif Case Drb_g& @Load.bit(0) Endselect $S% ' ' Return ' Procedure Drcs_vw(Mx&,My&) Local C&,E& ' Mx&=@Wxrcoord(5,Mx&)-Drs_x& My&=@Wyrcoord(5,My&)-Drs_y& ' If Mx&=>0 And My&=>0 And Mx&<=12*47 And My&<=4*$ And And And And Eqv Xor ' C&=Mx&\12+(Mod(My&,28)\14)*47 E&=My&\28 ' If E&=>0 And C&=>0 And E&<=1 And C&<=93 If E&=0 ~@Infow(5,"CaractŠre textuel … ‚diter: '"+Chr$(C&+33)+"' ,#"+Str$(C&+33)+" ,$"+Hex$(C&+33)) Else ~@Infow(5,"CaractŠre graphique … ‚diter: '"+Chr$(C&+33)+"' ,#"+Str$(C&+33)+" ,$"+Hex$(C&+33)) Endif Endif Endif ' Return ' Procedure Drsdraw(E&,C&) Local A&,B& ' For B&=0 To 9 For A&=0 To 7 If Btst(Drcs|(E&,C&,B&),7-A&) Ob_state(Adr%(16),Dr_first&+A&+B&*8)=Bset(Ob_state(Adr%(16),Dr_first&+A&+B&*8),0) Else Ob_state(Adr%(16),Dr_first&+A&+B&*8)=Bclr(Ob_state(Adr%(16),Dr_first&+A&+B&*8),0) Endif Next A& Next B& Return ' ' Clavier: DRCS Procedure Selectdrcs(Key&) Local X&,Y&,W&,H&,N&,A& ' N&=@Upcase(Key&) ' X&=N& If Help! Gosub Help(5,N&) ' N&=X& Endif ' $S& Select N& Case 0 Case 148 If @Form_alert(1,"[2][|T‚l‚charger jeu vers |le minitel 2 ?|][Confirmer| Annuler ]")=1 Gosub Drs_tel(False) Endif Case 146 ' If @Form_alert(1,"[2][|T‚l‚charger jeu vers |le minitel 2 ?|][Confirmer| Annuler ]")=1 Gosub Drs_tel(True) ' Endif Case 174 ' Drcs!=@Form_alert(Abs(Drcs!)+1,"[2][|Capturer jeu de caractŠre |en continu?|][Confirmer| Annuler ]")=1 Drcs!=Not Drcs! @Test_menu ' Case 166 ! load Gosub Load.sfd(False) Case 167 ! Importer.. Gosub Import.sfd Case 177 ! \iNsert - idem mais en s‚lectionnant Gosub Load.sfd(True) Case 159 ! save Gosub Save.sfd(False) Case 172 ! \Write Gosub Save.sfd(True) Case 175 ! \save vid‚oTex - save vdt Gosub Save.sfv(False) Case 173 ! \eXport - idem mais en selectionnant Gosub Save.sfv(True) Case 165 Gosub Clr_jeu ! effacer? ' Case 150 ! G0/G0',G1/G1' Gosub Defmouse(2) @Send2(Drctoff$) Gosub Defmouse(0) Case 151 Gosub Defmouse(2) @Send2(Drcton$) Gosub Defmouse(0) Case 152 Gosub Defmouse(2) @Send2(Drcgoff$) Gosub Defmouse(0) Case 153 Gosub Defmouse(2) @Send2(Drcgon$) Gosub Defmouse(0) ' Case 176 ! BitMap manage / load Gosub Top(6) If Bitmap%<=0 @Load.bit(0) Endif Case 888 Rim_chem ' Case 33 To 127 @Videkbd ~@Infow(5,"CaractŠre … ‚diter: '"+Chr$(Key&)+"' ,#"+Str$(Key&)+" ,$"+Hex$(Key&)) X&=@Wxacoord(5,Mod(Key&-33,47)*12+Drs_x&) Y&=@Wyacoord(5,Div(Key&-33,47)*14+Drs_y&) W&=12 H&=48 If Rc_intersect(W_ix&(5),W_iy&(5),W_iw&(5),W_ih&(5),X&,Y&,W&,H&) @Clip(X&,Y&,W&,H&) X&=@Wxacoord(5,Mod(Key&-33,47)*12+Drs_x&) Y&=@Wyacoord(5,Div(Key&-33,47)*14+Drs_y&) @Hidem Graphmode (3) Gosub Deffill(1,1,1) Gosub Pbox(X&,Y&,X&+12,Y&+14) Gosub Pbox(X&,Y&+28,X&+12,Y&+36) ~Evnt_timer(250) Gosub Pbox(X&,Y&,X&+12,Y&+14) Gosub Pbox(X&,Y&+28,X&+12,Y&+36) Graphmode (1) @Showm @Clip_off Endif Endselect $S% ' Return ' ' T‚l‚chargement DRCS Procedure Drs_tel(Flag!) Local A&,C&,T& Local E$,A$,B$ ' E$=String$(188,&HFF) ! 94*2 If Flag! Chs_set(True) E$=@Chsel$("t‚l‚charger") Endif ' If Len(E$)>0 ' Gosub Defmouse(2) ~@Infow(5,"Transcription en cours...") Clr A$,B$ Clr T& For C&=0 To 1 For B&=0 To 93 If Asc(Mid$(E$,B&+C&*94+1,1))=&HFF ! send it? If C&=0 A$=A$+Chr$(B&) Else B$=B$+Chr$(B&) Endif Inc T& Endif Next B& Next C& ' ~@Infow(5,"T‚l‚chargement en cours...") Gosub Defmouse(2) If Len(A$)>0 ~@Infow(5,"T‚l‚chargement en cours... FONTE TEXTE") @Send2(@Telchar$(0,A$)) Endif If Len(B$)>0 ~@Infow(5,"T‚l‚chargement en cours... FONTE GRAPH") @Send2(@Telchar$(1,B$)) Endif ~@Infow(5,Str$(T&)+" caractŠres t‚l‚charg‚s") Gosub Defmouse(0) ' Endif ' Return ' ' Sauvegardes: Flag (True=s‚lectionner) ' ' Type.B+Char.B puis 10 octets de d‚finition = 12 octets/char ' Procedure Load.sfd(Flag!) Local A&,E&,D&,T& Local E$,A$ Local File$ ' E$=String$(188,&HFF) ! 94*2 If Flag! Chs_set(False) E$=@Chsel$("charger") Endif ' If Len(E$)>0 File$=@Fsel$("\*.SFD",File$(4),"Charger caractŠres") If Len(File$)>0 If Exist(File$) File$(4)=File$ Fmshow("Chargement des caractŠres") Gosub Defmouse(2) Open "I",#1,File$(4) If Lof(#1)>8 If Input$(8,#1)="SWT2DRCS" Clr T& While Not Eof(#1) E&=Inp(#1) D&=Inp(#1) A$=Input$(10,#1) If E&=>0 And D&=>0 And E&<=1 And D&<=93 If Asc(Mid$(E$,D&+E&*94+1,1))=&HFF ! load it? For A&=0 To 9 Drcs|(E&,D&,A&)=Asc(Mid$(A$,A&+1,1)) Next A& Inc T& Endif Endif Wend Else ~@Form_alert(1,@Errf$(35)) Endif Else ~@Form_alert(1,@Errf$(35)) Endif Close #1 Gosub Defmouse(0) Fmhide Gosub Comm.info("Charger *.SFD",Str$(T&)+" caractŠres charg‚s") ~@Infow(5,Str$(T&)+" caractŠres charg‚s") ' ~Form_dial(3,0,0,0,0,W_ix&(5),W_iy&(5),W_iw&(5),W_ih&(5)) Rdw_all(5) Else ~@Form_alert(1,@Errf$(-33)) Endif Endif Endif ' Return ' Procedure Import.sfd Local X&,Y&,A& ' Binair$(6)="" X&=Actb& Actb&=6 Gosub Load.vdt Actb&=X& Gosub W_rdexe If Len(Binair$(6))>0 X&=Redir! Y&=Drcs! Redir!=True Drcs!=True ' ~@Selectk(5) Fmshow("D‚codage en cours..") For A&=1 To Len(Binair$(6)) ' Gosub Emanage(True,Asc(Mid$(binair$(6),1))) Gosub Emanage(False,Asc(Mid$(Binair$(6),A&,1))) ' Send(Mid$(binair$(6),A%,10)) If Mod(A&,64)=0 Gosub Defmouse(2) Endif Exit if @Shiftbrk2 ! break Next A& Fmhide Gosub Defmouse(0) Redir!=(X&=-1) Drcs!=(Y&=-1) Gosub Comm.info("Importer fonte *.VDT","CaractŠres charg‚s") If Wopen!(5) Rdw_all(5) Endif Endif Return ' Procedure Clr_jeu If @Form_alert(1,"[3][|Attention, le jeux DRCS va ˆtre effac‚|ainsi que les motifs|][Confirmer| Annuler ]")=1 Gosub Defmouse(2) Gosub Drcs_uninit Gosub Drcs_init If Wopen!(5) Rdw_all(5) ' ~Form_dial(3,0,0,0,0,W_ix&(5),W_iy&(5),W_iw&(5),W_ih&(5)) Endif Gosub Defmouse(0) Endif Return ' ' save.sfd/sfv en bloc save ' ' Function Chsel$(A$) Local E$ Local A& Local A! Local X&,Y&,B&,K&,C& ' Char{Ob_spec(Adr%(17),Ds_tit&)}="CaractŠres … "+A$ ' E$=String$(188,&HFF) ! 94*2 For A&=Ds_tfirst& To Ds_tlast& ' Ob_state(Adr%(17),A&)=Bclr(Ob_state(Adr%(17),A&),0) Char{Ob_spec(Adr%(17),A&)}=Chr$(A&-Ds_tfirst&+33) Next A& For A&=Ds_gfirst& To Ds_glast& ' Ob_state(Adr%(17),A&)=Bclr(Ob_state(Adr%(17),A&),0) Char{Ob_spec(Adr%(17),A&)}=Chr$(A&-Ds_gfirst&+33) Next A& ' Gosub Chx ' If Len(E$)>0 For A&=Ds_tfirst& To Ds_tlast& If Btst(Ob_state(Adr%(17),A&),0)=False Mid$(E$,A&-Ds_tfirst&+1,1)=Chr$(0) Endif Next A& For A&=Ds_gfirst& To Ds_glast& If Btst(Ob_state(Adr%(17),A&),0)=False Mid$(E$,A&-Ds_gfirst&+1+94,1)=Chr$(0) Endif Next A& Endif ' Return E$ Endfunc Procedure Chsel(A$) Local A& Local A! Local X&,Y&,B&,K&,C& ' Char{Ob_spec(Adr%(17),Ds_tit&)}="CaractŠres … "+A$ ' For A&=Ds_tfirst& To Ds_tlast& Char{Ob_spec(Adr%(17),A&)}=Chr$(A&-Ds_tfirst&+33) Next A& For A&=Ds_gfirst& To Ds_glast& Char{Ob_spec(Adr%(17),A&)}=Chr$(A&-Ds_gfirst&+33) Next A& ' Gosub Chx ' For A&=0 To 94*2-1 Keep|(A&)=0 ! init, on peut tout utiliser! Next A& ' For A&=Ds_tfirst& To Ds_tlast& If Not Btst(Ob_state(Adr%(17),A&),0) Keep|(A&-Ds_tfirst&)=&HFF Endif Next A& For A&=Ds_gfirst& To Ds_glast& If Not Btst(Ob_state(Adr%(17),A&),0) Keep|(A&-Ds_gfirst&+94)=&HFF Endif Next A& ' Return Procedure Chx Exdo!=True Do A&=Byte(@Form_wdo(17,0)) Select A& Case Ds_tp& Ob_state(Adr%(17),A&)=Bclr(Ob_state(Adr%(17),A&),0) ' Exdo!=True For B&=Ds_tfirst& To Ds_tlast& Ob_state(Adr%(17),B&)=Bset(Ob_state(Adr%(17),B&),0) Next B& ~Objc_draw(Adr%(17),Ds_t&,255,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) ~Objc_draw(Adr%(17),A&,7,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) Case Ds_tm& Ob_state(Adr%(17),A&)=Bclr(Ob_state(Adr%(17),A&),0) ' Exdo!=True For B&=Ds_tfirst& To Ds_tlast& Ob_state(Adr%(17),B&)=Bclr(Ob_state(Adr%(17),B&),0) Next B& ~Objc_draw(Adr%(17),Ds_t&,255,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) ~Objc_draw(Adr%(17),A&,7,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) Case Ds_gp& Ob_state(Adr%(17),A&)=Bclr(Ob_state(Adr%(17),A&),0) ' Exdo!=True For B&=Ds_gfirst& To Ds_glast& Ob_state(Adr%(17),B&)=Bset(Ob_state(Adr%(17),B&),0) Next B& ~Objc_draw(Adr%(17),Ds_g&,255,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) ~Objc_draw(Adr%(17),A&,7,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) Case Ds_gm& Ob_state(Adr%(17),A&)=Bclr(Ob_state(Adr%(17),A&),0) ' Exdo!=True For B&=Ds_gfirst& To Ds_glast& Ob_state(Adr%(17),B&)=Bclr(Ob_state(Adr%(17),B&),0) Next B& ~Objc_draw(Adr%(17),Ds_g&,255,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) ~Objc_draw(Adr%(17),A&,7,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) Case Ts_ok& Ob_state(Adr%(17),A&)=Bclr(Ob_state(Adr%(17),A&),0) Exit if True Case Ts_cancel&,0,1 Ob_state(Adr%(17),A&)=Bclr(Ob_state(Adr%(17),A&),0) Clr E$ Exit if True Case Ds_tfirst& To Ds_tlast& A!=Not Btst(Ob_state(Adr%(17),A&),0) Ob_state(Adr%(17),A&)=Bchg(Ob_state(Adr%(17),A&),0) ~Objc_draw(Adr%(17),A&,7,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) ~Graf_mkstate(X&,Y&,K&,B&) If K&<>0 Gosub Defmouse(3) While K&<>0 C&=Objc_find(Adr%(17),0,7,X&,Y&) If C&=0 C&=Ds_tlast& Endif Select C& Case Ds_tfirst& To Ds_tlast& For B&=A& To C& If Btst(Ob_state(Adr%(17),B&),0)<>A! If A! Ob_state(Adr%(17),B&)=Bset(Ob_state(Adr%(17),B&),0) Else Ob_state(Adr%(17),B&)=Bclr(Ob_state(Adr%(17),B&),0) Endif ~Objc_draw(Adr%(17),B&,7,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) Endif Next B& Endselect ~Graf_mkstate(X&,Y&,K&,B&) Wend Gosub Defmouse(0) Endif ~Objc_draw(Adr%(17),Ds_t&,255,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) Case Ds_gfirst& To Ds_glast& A!=Not Btst(Ob_state(Adr%(17),A&),0) Ob_state(Adr%(17),A&)=Bchg(Ob_state(Adr%(17),A&),0) ~Objc_draw(Adr%(17),A&,7,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) ~Graf_mkstate(X&,Y&,K&,B&) If K&<>0 Gosub Defmouse(3) While K&<>0 C&=Objc_find(Adr%(17),0,7,X&,Y&) If C&=0 C&=Ds_glast& Endif Select C& Case Ds_gfirst& To Ds_glast& For B&=A& To C& If Btst(Ob_state(Adr%(17),B&),0)<>A! If A! Ob_state(Adr%(17),B&)=Bset(Ob_state(Adr%(17),B&),0) Else Ob_state(Adr%(17),B&)=Bclr(Ob_state(Adr%(17),B&),0) Endif ~Objc_draw(Adr%(17),B&,7,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) Endif Next B& Endselect ~Graf_mkstate(X&,Y&,K&,B&) Wend Gosub Defmouse(0) Endif ~Objc_draw(Adr%(17),Ds_g&,255,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) Endselect Loop ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(17),Ry&(17),Rw&(17),Rh&(17)) ~@Form_wdo(17,-3) Return ' ' Pr‚selection! Procedure Chs_set(Flag!) Local A&,B&,C& ' Gosub Defmouse(2) For A&=Ds_tfirst& To Ds_tlast& Clr C& For B&=0 To 9 Add C&,Drcs|(0,A&-Ds_tfirst&,B&) Next B& ' If C&=0 Or (C&=1 And Drcs|(0,A&-Ds_tfirst&,0)=1) If Flag! Ob_state(Adr%(17),A&)=Bclr(Ob_state(Adr%(17),A&),0) Else Ob_state(Adr%(17),A&)=Bset(Ob_state(Adr%(17),A&),0) Endif Else If Flag! Ob_state(Adr%(17),A&)=Bset(Ob_state(Adr%(17),A&),0) Else Ob_state(Adr%(17),A&)=Bclr(Ob_state(Adr%(17),A&),0) Endif Endif ' Next A& For A&=Ds_gfirst& To Ds_glast& Clr C& For B&=0 To 9 Add C&,Drcs|(1,A&-Ds_gfirst&,B&) Next B& ' ' Insignifiant (1 pt … droite ou a gauche) If C&=0 Or (C&=1 And Drcs|(1,A&-Ds_gfirst&,0)=1) If Flag! Ob_state(Adr%(17),A&)=Bclr(Ob_state(Adr%(17),A&),0) Else Ob_state(Adr%(17),A&)=Bset(Ob_state(Adr%(17),A&),0) Endif Else If Flag! Ob_state(Adr%(17),A&)=Bset(Ob_state(Adr%(17),A&),0) Else Ob_state(Adr%(17),A&)=Bclr(Ob_state(Adr%(17),A&),0) Endif Endif ' Next A& Gosub Defmouse(0) ' Return ' ' ' ' ' ' T‚l‚chargement en bloc. N&=text/graph ; T$= Chr$(Char)*n Function Telchar$(N&,T$) Local C&,A&,E$ ' ' Head If N&=0 E$=Ldt$ Else E$=Ldg$ Endif ' ' Load first char C&=Asc(Mid$(T$,A&,1)) E$=E$+Mki$(&H1F23)+Chr$(C&+33)+Chr$(&H30) ' ' T‚l‚charger tous les caratŠres selectionn‚s For A&=1 To Len(T$) ' ' Char: C&=Asc(Mid$(T$,A&,1)) ' ' Trame de contr“le DRCS E$=E$+@Teltrame$(N&,C&) ' ' Load next: If A&0 And Len(D$)>0 ! Donn‚es … transmettre! If Len(D$)=>6 X&=Val("&X"+Left$(D$,6)) Else X&=Val("&X"+Left$(D$,2)+"0000") Endif E$=E$+Chr$(Bset(X&,6)) ! +64 a cause des char sp‚ciaux D$=Mid$(D$,7) Wend Return E$ Endfunc ' ' Procedure Drs_tra(Y&,W&,A&,B&,C&,D&,E&,F&,G&,H&,I&,J&,K&,L&,M&,N&) Local T$,X&,Z& ' ' Transcrire.. Clr T$ A&=A& And &X111111 B&=B& And &X111111 C&=C& And &X111111 D&=D& And &X111111 E&=E& And &X111111 F&=F& And &X111111 G&=G& And &X111111 H&=H& And &X111111 I&=I& And &X111111 J&=J& And &X111111 K&=K& And &X111111 L&=L& And &X111111 M&=M& And &X111111 N&=N& And &X111111 ' N&=Ror(N&,4) ' T$=T$+Bin$(A&,6) T$=T$+Bin$(B&,6) T$=T$+Bin$(C&,6) T$=T$+Bin$(D&,6) T$=T$+Bin$(E&,6) T$=T$+Bin$(F&,6) T$=T$+Bin$(G&,6) T$=T$+Bin$(H&,6) T$=T$+Bin$(I&,6) T$=T$+Bin$(J&,6) T$=T$+Bin$(K&,6) T$=T$+Bin$(L&,6) T$=T$+Bin$(M&,6) T$=T$+Bin$(N&,6) ' ' Et inscrire! For X&=0 To 9 ' Clr A$ ' For Z&=8 Downto 1 ' A$=A$+Mid$(T$,X&*8+Z&,1) ' Next Z& ' ' eDrcs|(Y&,W&,X&)=Val("&X"+A$) Edrcs|(Y&,W&,X&)=Val("&X"+Mid$(T$,X&*8+1,8)) ' ' ' Transfert? If Drcs! Drcs|(Y&,W&,X&)=Edrcs|(Y&,W&,X&) Endif Next X& ' ' Ici on efface tous les caractŠres 'W&' du cache.. Clr Pc_a& Do ' Recherche: 3 objets, 3 adresses, max_obj (index), from (index) Pc_a&=C:Swchar%(W:W&+33,W:0,W:Y&,L:V:Cachs&(0),L:V:Cachc&(0),L:V:Cacha|(0),W:Ncach&,W:Pc_a&) If Pc_a&=>0 Cachs&(Pc_a&)=0 ! effacer!! Cacha|(Pc_a&)=0 Endif Inc Pc_a& Loop until Pc_a&<=0 Or Pc_a&>Ncach& ' Return ' ' R‚actualiser cacartŠres drcs, index W& / T&=0 si texte, =1 si graphique / flag redessiner? Procedure Vdt_reac(T&,W&,Flag!) Local X&,Y&,A& ' If Flag! Clr A& Do ' max=2000 (80*25) ' Recherche: 3 objets, 3 adresses, max_obj (index), from (index) A&=C:Swchar%(W:W&+33,W:0,W:T&,L:V:Vids&(0,0),L:V:Vidc&(0,0),L:V:Vida|(0,0),W:2000-1,W:A&) If A&=>0 If A&<1999 X&=Mod(A&,80) Y&=Div(A&,80) Gosub Vdraw(X&,Y&) Endif Endif Inc A& Loop until A&<=0 Or A&>1999 Endif Return ' ' ' ' /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ ' BitMap manager ' /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ ' ' Procedure Bit_init ' If Bitmap%>0 Bit_uninit Endif ' ' Pas de buffer pour l'instant! Bitmap%=-1 Bitw&=640 Bith&=400 Bitl&=80 If Dim?(Wopen!()) Wset_max_w(6,Min(Bitw&,W_desk&-50)) Wset_max_h(6,Min(Bith&,H_desk&-20)) If Wopen!(6) @Wsetsl(6) ~@Infow(6,"Image: "+Str$(Bitw&)+"*"+Str$(Bith&)) Endif Endif Return Procedure Bit_uninit If Bitmap%>0 ~@Mfree(Bitmap%) Bitmap%=-1 Endif If Dim?(W_ix&()) ~@Titlew(6,"SANS_NOM.IMG - "+Name$) Endif Bitw&=640 Bith&=400 Bitl&=80 ' Bm_x&=-1 Bm_y&=-1 Bm_w&=-1 Bm_h&=-1 Return Procedure Bit_set(W&,H&) ' If Bitmap%>0 Bit_uninit Endif ' ' If Mod(W&,16)<>0 ' W&=(W&\16+1)*16 ' Endif Bitw&=W& Bith&=H& If Mod(Bitw&,16)=0 Bitl&=Bitw&\8 ! bit line length Else Bitl&=((Bitw&\16+1)*16)\8 ! bit line length (octets) Endif Bitmap%=@Malloc(Bith&*Bitl&) If Bitmap%>0 ' *~C:Clrblk%(L:Bitmap%,L:(Bith&*Bitl&)) If Dim?(Wopen!()) Wset_max_w(6,Bitw&) ! un peu de place! Wset_max_h(6,Bith&) ! idem Wset_start_x(6,0) Wset_start_y(6,0) If Wopen!(6) Gosub Setxywh(6,W_ex&(6),W_ey&(6),W_ew&(6),W_eh&(6)) @Wsetsl(6) Endif ~@Infow(6,"Image: "+Str$(Bitw&)+"*"+Str$(Bith&)) Endif Else Bitw&=640 Bith&=400 Bitmap%=-1 Endif Return Procedure Bit_draw(X&,Y&,W&,H&) ' Local E$ ' Local W2&,W2& ' @Lhidem If Bitmap%>0 ' If Clip_x&=>0 If X&0 If Y&Bitw&-X&) Or (W&>Bitw&-X&) @Deffillcol(0) @Pbox(@Wxacoord(6,X&),@Wyacoord(6,Y&),@Wxacoord(6,X&)+W&-1,@Wyacoord(6,Y&)+H&-1) @Deffillcol(Colg&) W&=Max(0,Min(Bitw&-X&,W&)) H&=Max(0,Min(Bith&-Y&,H&)) Endif ' If X&=>0 And Y&=>0 And W&>0 And H&>0 ' G_s&(0)=Word(Swap(Bitmap%)) G_s&(1)=Word(Bitmap%) G_s&(2)=Bitw& G_s&(3)=Bith& G_s&(4)=Bitl&\2 G_s&(5)=0 G_s&(6)=1 ! Mono G_s&(7)=0 G_s&(8)=0 G_s&(9)=0 ' Contrl(0)=121 ! Copy raster transparent Contrl(1)=4 Contrl(3)=3 Contrl(6)=V~h Intin(0)=1 ! GraphMode Intin(1)=1 ! Couleur Intin(2)=0 ! et fond Ptsin(0)=X& ! Coord src Ptsin(1)=Y& Ptsin(2)=X&+W&-1 ! Coord src Ptsin(3)=Y&+H&-1 Ptsin(4)=@Wxacoord(6,X&) ! Coord src dest Ptsin(5)=@Wyacoord(6,Y&) Ptsin(6)=@Wxacoord(6,X&+W&-1) ! Coord src dest Ptsin(7)=@Wyacoord(6,Y&+H&-1) ' ~Fre(0) Contrl(7)=Word(Swap(V:G_s&(0))) Contrl(8)=Word(V:G_s&(0)) Contrl(9)=Word(Swap(V:G_screen%(0))) Contrl(10)=Word(V:G_screen%(0)) Vdisys ! EXECUTER! ' Endif ' If Bm_x&=>0 Graphmode (3) Defline 4,1,0 @Box(@Wxacoord(6,Bm_x&),@Wyacoord(6,Bm_y&),@Wxacoord(6,Bm_x&)+Bm_w&-1,@Wyacoord(6,Bm_y&)+Bm_h&-1) Defline 0,1,0 Graphmode (1) Endif ' Else ! Pas de dessin charg‚! Gosub Deffill(1,2,1) @Bndary(0) Gosub Pbox(X&,Y&,X&+W&-1,Y&+H&-1) @Bndary(1) Endif If Pic_x&<>-1 Gosub Picl ! dessiner ligne pix Endif ' @Lshowm Return Procedure Bitkey(Key&) Local X&,Y& ' Select Key& Case "L" Gosub Load.bit(False) Case "A" Gosub Load.bit(True) Case "E" Gosub Ifx_do Case 128 If Bitmap%>0 If @Form_alert(1,"[3][|Effacer image? |][Confirmer|Annuler]")=1 Bit_uninit Rdw_all(6) Test_menu Endif Else ~@Form_alert(1,"[3][|Pas d'image! |][Confirmer]") Endif Case 888 Rim_chem Case 13 If Bm_x&=>0 Gosub Pixsel(-1,-1) Endif Case 32 If Pic_x&=>0 X&=Pic_x& Y&=Pic_y& If Mod(X&,8)<>0 X&=(X&\8+1)*8 Endif If Mod(Y&,10)<>0 Y&=(Y&\10+1)*10 Endif ~@Infow(6,"Coord X: "+Str$(Pic_x&)+" Y: "+Str$(Pic_y&)+" (dims: W: "+Str$(Bitw&)+" H: "+Str$(Bith&)+" - max: W: "+Str$(Bitw&-Pic_x&)+" H: "+Str$(Bith&-Pic_y&)+" <=> "+Str$((Bitw&-X&)\8)+"*"+Str$((Bith&-Y&)\10)+")") Endif Case 9 If Bm_x&=>0 X&=Bm_w& Y&=Bm_h& If Mod(X&,8)<>0 X&=(X&\8+$ And And And And Imp $8 Endif If Mod(Y&,10)<>0 Y&=(Y&\10+$ And And And And Imp $10 Endif ~@Infow(6,"Coord X: "+Str$(Bm_x&)+" Y: "+Str$(Bm_y&)+" W: "+Str$(Bm_w&)+" H: "+Str$(Bm_h&)+" ( "+Str$(X&\8)+"*"+Str$(Y&\10)+" )") Endif Case 200,208,203,205,"2","4","6","8" If Bitmap%>0 @Wind_clip(6) Graphmode (3) Defline 4,1,0 @Lhidem If Bm_x&<0 Bm_x&=0 Bm_y&=0 Bm_w&=100 Bm_h&=100 @Box(@Wxacoord(6,Bm_x&),@Wyacoord(6,Bm_y&),@Wxacoord(6,Bm_x&)+Bm_w&-1,@Wyacoord(6,Bm_y&)+Bm_h&-1) Endif ' @Box(@Wxacoord(6,Bm_x&),@Wyacoord(6,Bm_y&),@Wxacoord(6,Bm_x&)+Bm_w&-1,@Wyacoord(6,Bm_y&)+Bm_h&-1) If And(Bclr(Bios(11,-1),5),&X11)=0 Select Key& Case 200 ! h Bm_y&=Max(0,Bm_y&-1) Case 208 ! b Bm_y&=Min(Bith&-Bm_h&,Bm_y&+1) Case 203 ! g Bm_x&=Max(0,Bm_x&-1) Case 205 ! d Bm_x&=Min(Bitw&-Bm_w&,Bm_x&+1) Endselect Else Select Key& Case 200,"8" ! h Bm_h&=Max(1,Bm_h&-1) Case 208,"2" ! b Bm_h&=Min(Bith&-Bm_y&,Bm_h&+1) Case 203,"4" ! g Bm_w&=Max(1,Bm_w&-1) Case 205,"6" ! d Bm_w&=Min(Bitw&-Bm_x&,Bm_w&+1) Endselect Endif ' @Box(@Wxacoord(6,Bm_x&),@Wyacoord(6,Bm_y&),@Wxacoord(6,Bm_x&)+Bm_w&-1,@Wyacoord(6,Bm_y&)+Bm_h&-1) Graphmode (1) Defline 0,1,0 @Lshowm Endif Default ~@Infow(6,"Return: derniŠres coord - Space: voir actuelles - Tab: voir anciennes - (shift)"+Mkl$(&H1020304)) Endselect ' Return ' ' Procedure Rim_chem Local A& ' If Parx$(0)=Parx$ Ob_state(Adr%(42),Px2_rim&)=Bset(Ob_state(Adr%(42),Px2_rim&),0) Else Ob_state(Adr%(42),Px2_rim&)=Bclr(Ob_state(Adr%(42),Px2_rim&),0) Endif If Parx$(1)=Parx$ Ob_state(Adr%(42),Px2_wim&)=Bset(Ob_state(Adr%(42),Px2_wim&),0) Else Ob_state(Adr%(42),Px2_wim&)=Bclr(Ob_state(Adr%(42),Px2_wim&),0) Endif If Parx$(2)=Parx$ Ob_state(Adr%(42),Px2_ifx&)=Bset(Ob_state(Adr%(42),Px2_ifx&),0) Else Ob_state(Adr%(42),Px2_ifx&)=Bclr(Ob_state(Adr%(42),Px2_ifx&),0) Endif If Parx$(3)=Parx$ Ob_state(Adr%(42),Px2_trm&)=Bset(Ob_state(Adr%(42),Px2_trm&),0) Else Ob_state(Adr%(42),Px2_trm&)=Bclr(Ob_state(Adr%(42),Px2_trm&),0) Endif If Parx$(4)=Parx$ Ob_state(Adr%(42),Px2_pal&)=Bset(Ob_state(Adr%(42),Px2_pal&),0) Else Ob_state(Adr%(42),Px2_pal&)=Bclr(Ob_state(Adr%(42),Px2_pal&),0) Endif If Px_card! Ob_state(Adr%(42),Px2_card&)=Bset(Ob_state(Adr%(42),Px2_card&),0) Else Ob_state(Adr%(42),Px2_card&)=Bclr(Ob_state(Adr%(42),Px2_card&),0) Endif ' Char{Ob_spec(Adr%(42),Px2_path&)}=Right$(Parx$,36) Exdo!=True Do A&=Byte(@Form_wdo(42,0)) Ob_state(Adr%(42),A&)=Bclr(Ob_state(Adr%(42),A&),0) ~Objc_draw(Adr%(42),A&,7,Rx&(42),Ry&(42),Rw&(42),Rh&(42)) Select A& Case Px2_path& If @Form_alert(1,"[3][Vous devez indiquer la |localisation du dossier |PARX.SYS pour utiliser le |transfert DRCS][Confirmer| Annuler ]")=1 ~@Form_wdo(42,-3) Do Parx$=@Fsel$("\*.*","","Chemin PARX.SYS ?") Exit if Len(File$)=0 If Rinstr(Parx$,"\")>0 Parx$=Left$(Parx$,Rinstr(Parx$,"\")) Endif Exit if @Exist(File$+"*.*") Loop Char{Ob_spec(Adr%(42),Px2_path&)}=Right$(Parx$,36) ~Objc_draw(Adr%(42),Px2_path&,7,Rx&(42),Ry&(42),Rw&(42),Rh&(42)) Exdo!=True ~@Form_wdo(42,-2) Endif Default Exit if True Endselect Loop If A&=Px2_ok& Or A&=Px2_sv& If Btst(Ob_state(Adr%(42),Px2_rim&),0) Parx$(0)=Parx$ Else Parx$(0)=Set_path$ Endif If Btst(Ob_state(Adr%(42),Px2_wim&),0) Parx$(1)=Parx$ Else Parx$(1)=Set_path$ Endif If Btst(Ob_state(Adr%(42),Px2_ifx&),0) Parx$(2)=Parx$ Else Parx$(2)=Set_path$ Endif If Btst(Ob_state(Adr%(42),Px2_trm&),0) Parx$(3)=Parx$ Else Parx$(3)=Set_path$ Endif If Btst(Ob_state(Adr%(42),Px2_pal&),0) Parx$(4)=Parx$ Else Parx$(4)=Set_path$ Endif If Btst(Ob_state(Adr%(42),Px2_card&),0) Px_card!=True Else Px_card!=False Endif ' ~@Form_wdo(42,-3) If A&=Px2_sv& Gosub Sv.parx Endif Rim_uninit Rim_load Else ~@Form_wdo(42,-3) Endif Return Procedure Rim_init Local A& ' If Rim%>0 ~@Mfree(Rim%) Rim%=-1 Endif If Wim%>0 ~@Mfree(Wim%) Wim%=-1 Endif ' If (Parx$="!") Or (Not @Exist(Parx$+"*.*")) If @Form_alert(1,"[3][Vous devez indiquer la |localisation du dossier |PARX.SYS pour utiliser le |transfert DRCS][Confirmer| Annuler ]")=1 Do Parx$=@Fsel$("\","","Chemin PARX.SYS ?") Exit if Len(File$)=0 If Rinstr(Parx$,"\")>0 Parx$=Left$(Parx$,Rinstr(Parx$,"\")) Endif Exit if @Exist(File$+"*.*") Loop For A&=0 To 4 Parx$(A&)=Parx$ Next A& Else Parx$="C:\PARX.SYS\" Endif Endif ' Gosub Rim_load ' If Rim%=0 Or Wim%=0 Or Trm%=0 Or Ifx%=0 If Rim%=0 And Wim%=0 And Trm%=0 And Ifx%=0 If Parx$<>"C:\PARX.SYS\" ~@Form_alert(1,"[1][|Le dossier PARX n'a pas ‚t‚ |localis‚. |][Confirmer]") Endif Else ~@Form_alert(1,"[1][|Des fichiers PARX n'ont pas |‚t‚ localis‚s. |][Confirmer]") Endif Endif ' Return Procedure Rim_load Local R% ' If @Exist(Parx$+"*.*") ' @Fmshow("Chargement des modules RIM PARX") Rsiz%=@Read_xx("RIM\","*.RIM","RIM",Parx$(0),"READ_IMG",Rim%) @Fmshow("Chargement des modules WIM PARX") Wsiz%=@Read_xx("WIM\","*.WIM","WIM",Parx$(1),"WRIT_IMG",Wim%) @Fmshow("Chargement des modules IFX PARX") Wifx%=@Read_xx("IFX\","*.IFX","IFX",Parx$(2),"IFX__IMG",Ifx%) @Fmshow("Chargement du fichier TRM PARX") Read_trm @Fmhide ' ~Fre(0) ' If Trm%>0 R%=Trm%+&H7A6+2 ~C:R%(2,Abs(Px_card!),L:0,L:0,L:0,L:0,L:0,0) Endif ' @Fmhide Else Rim%=0 Wim%=0 Trm%=0 Let Ifx%=0 Endif ' Return Procedure Read_trm Local A$ Local E%,H% Local L% ' If Trm%>0 ~@Mfree(Trm%) Trm%=-1 Endif ' A$=Parx$(3)+"PARX.TRM" If @Exist(A$) Gosub Defmouse(2) Open "i",#1,A$ L%=Lof(#1) Trm%=@Malloc(L%) If Trm%>0 Bget #1,Trm%,L% Else Clr Trm% ~Form_alert(1,"[3][|Erreur au chargement du TRM|M‚moire insuffisante|][ Annuler ]") Endif Close #1 Gosub Defmouse(0) ' If Trm%>0 If Long{Trm%}=Cvl("PARX") And Long{Trm%+4}=Cvl("_TRM") Select Word{Trm%+8} Case 200 To 299 Default ~@Mfree(Trm%) Endselect Else ~@Mfree(Trm%) Endif If Trm%<=0 ~Form_alert(1,"[3][|Erreur au chargement du TRM|Version non reconnue|Contactez PARX][ Annuler ]") Endif Endif ' Else Clr Trm% ~Form_alert(1,"[3][|Erreur au chargement du TRM| (non trouv‚)|][ Annuler ]") Endif ' Return Function Read_xx(E$,D$,T$,C$,Y$,Var R%) $F% Local A$,B$,X$ Local L%,E%,A%,H% Local N& Local Z% Local C& Local B% Local C% Local A&,B& ' Gosub Defmouse(2) A%=Fgetdta() Clr R% Dim Temp$(200),Len%(200),Temp2$(200),Temp%(200) ' A$=C$+E$+D$+Chr$(0) E%=Gemdos(78,L:V:A$,0) If E%=>0 N&=0 L%=0 Add L%,4 ! nombre de rims While E%=>0 And N&<199 Len%(N&)=Long{A%+26} If Len%(N&)>0 Temp$(N&)=Char{A%+30} If Div(Len%(N&),4)<>0 ! pas un multiple de 4 .. Add L%,(Len%(N&)\4+1)*4 ! on corrige Else Add L%,Len%(N&) ! +taille fichier Endif Add L%,4 ! +len cod‚e Inc N& Endif ' E%=Gemdos(79) Wend Dec N& Add L%,4 ! NULL Add L%,8 ! s‚curit‚ ' If N&=>0 Z%=L% R%=@Malloc(Z%) If R%>0 ' A%=R% Long{A%}=N& ! nbre-1 Add A%,4 ' Clr C& For A&=0 To N& B$=C$+E$+Temp$(A&)+Chr$(0) H%=Gemdos(61,L:V:B$,0) If H%=>0 ' E%=(Gemdos(63,H%,L:Len%(A&),L:A%+4)=0) If Div(Len%(A&),4)<>0 ! pas un multiple de 4 .. Len%(A&)=(Len%(A&)\4+1)*4 ! on corrige Endif Long{A%}=Len%(A&) ! noter taille ' If E%=0 ' B&=0 If A&-C&-1>0 Do If Temp%(B&)>0 ' Mˆme objet? If Long{Temp%(B&)+4+14}=Long{A%+4+14} And Long{Temp%(B&)+4+18}=Long{A%+4+18} If Word{A%+4+22}>Word{Temp%(B&)+4+22} ! newer! ~@Form_alert(1,"[3][|Vous pourrez effacer |"+Right$(Temp$(B&),25)+"|][Confirmer]") Temp%(B&)=-1 Else ~@Form_alert(1,"[3][|Vous pourrez effacer |"+Right$(Temp$(A&),25)+"|][Confirmer]") B&=-1 Exit if True Endif Endif Endif Inc B& Loop until B&>A&-C&-1 Endif ' If B&=>0 If Long{A%+4}=Cvl(Left$(Y$,4)) And Long{A%+8}=Cvl(Mid$(Y$,5,4)) ' If Byte{A%+4+24+30}=0 ' ' If Btst(Byte{A%+4+24+31},0) ! Config! ' C%=A%+4+24+30+2 ! POINTE SUR 1E ROUTINE ' Select T$ ' Case "RIM","WIM" ' Add C%,4*(4-1) ! 4e routine RIM/WIM ' Case "IFX" ' Add C%,4*(2-1) ! 2e routine IFX ' Default ' Clr C% ' Endselect ' If C%>0 ' X$=Parx$+Mki$(0) ' Select C:C%(W:1,L:V:X$) ! Config ' Case 0 ' Case -1 ' ~@Form_alert(1,"[3][|Erreur "+T$+"|Configuration impossible|][Annuler]") ' Case -2 ' ~@Form_alert(1,"[3][|Erreur "+T$+"|Configuration erron‚e|][Annuler]") ' Endselect ' Endif ' Endif ' Select Word{A%+4+12} Case 2,3 Temp2$(A&-C&)=Chr$(255)+Char{A%+4+24} Default Temp2$(A&-C&)=Chr$(1)+Char{A%+4+$ And And And And Eqv Imp } Endselect Temp%(A&-C&)=A% ' Add A%,4 Add A%,Len%(A&) ! ajouter taille fichier au pointeur Else ~@Form_alert(1,"[3][|Fichier non "+T$+":|"+Right$(Temp$(A&),25)+"][Annuler]") Inc C& Endif Else ~@Form_alert(1,"[3][|Fichier non "+T$+":|"+Right$(Temp$(A&),25)+"][Annuler]") Inc C& Endif Else Inc C& Endif ! old file ' Else ~Form_alert(1,"[3][Erreur au chargement de |"+Right$(Temp$(A&),30)+"|Erreur de lecture][ Annuler ]") Inc C& Endif ~Gemdos(62,H%) Else ~Form_alert(1,"[3][|Erreur au chargement des "+T$+"s|Erreur au chargement|][ Annuler ]") Endif Next A& If R%>0 If N&-C&=>0 Long{R%}=N&-C& Long{A%}=0 ! dernier = 0 ' E%=@Malloc(Z%) ! 2e bloc If E%>0 Qsort Temp2$(),N&-C&+1,Temp%() ! dans l'ordre svp Long{E%}=Long{R%} ! mˆme nbre B%=4 For A&=0 To N&-C&+1 If Temp%(A&)>0 If Temp%(A&)>0 Bmove Temp%(A&),E%+B%,Long{Temp%(A&)}+4 B%=B%+Long{Temp%(A&)}+4 Else ~Form_alert(1,"[3][|Erreur au chargement des "+T$+"s|Bloc corrompu|][ Annuler ]") Endif Endif Next A& Bmove E%,R%,Z% ~@Mfree(E%) Else ~@Mfree(R%) R%=-1 ~Form_alert(1,"[3][|Erreur au chargement des "+T$+"s|M‚moire insuffisante|][ Annuler ]") Endif ' Else ! on a meme pas pu en charger un!! ' ~@Mfree(R%) R%=-1 Endif Endif ' Else ~Form_alert(1,"[3][|Erreur au chargement des "+T$+"s|M‚moire insuffisante|][ Annuler ]") R%=0 Endif Else ~Form_alert(1,"[3][|Erreur au chargement des "+T$+"s|"+T$+"s non trouv‚s|][ Annuler ]") R%=0 Endif ' Else ~Form_alert(1,"[3][|Erreur au chargement des "+T$+"s|"+T$+"s non trouv‚s|][ Annuler ]") Endif Erase Temp$(),Len%(),Temp2$(),Temp%() ' Return Z% Endfunc ' Procedure Sv.parx Local A& Open "O",#1,Set_path$+"PARX.CNF" Print #1,"SWT2PARXV-10"; Print #1,Chr$(Px_card!); Print #1,Mki$(Len(Parx$))+Parx$; For A&=0 To 4 If Parx$(A&)=Parx$ Print #1,Chr$(-1); Else Print #1,Chr$(0); Endif Next A& Close #1 Return Procedure Ld.parx Local A& Parx$(0)="" If @Exist(Set_path$+"PARX.CNF") Open "I",#1,Set_path$+"PARX.CNF" If Lof(#1)>12 If Input$(12,#1)="SWT2PARXV-10" Px_card!=(Inp(#1)<>0) Parx$=Input$(Cvi(Input$(2,#1)),#1) For A&=0 To 4 If Inp(#1)<>0 Parx$(A&)=Parx$ Else Parx$(A&)=Set_path$ Endif Next A& Endif Endif Close #1 Endif If Len(Parx$)=0 Parx$=Chr$(65+Gemdos(25))+":\PARX.SYS\" Endif ' If Len(Parx$(0))=0 For A&=0 To 4 Parx$(A&)=Parx$ Next A& Endif Return ' Procedure Load.bit(Flag!) Local A%,R%,Mf1%,Mf2%,S%,M%,E%,B%,C%,T%,M2% Local A&,B&,C&,F& Local W&,H&,N& Local A! Local Adr%,Len% Local File$ Local Ext$ Local A$ Local H% Local Z& ' @Showm If Not Wopen!(6) ~@Wind_open(6) Gosub W_rdexe Endif ' A!=False ! non charg‚ ' H%=-1 Mf1%=@Malloc(72) Mf2%=Mf1%+20 Mf3%=Mf1%+40 Mpal%=Mf1%+60 Word{Mpal%}=0 ! black Word{Mpal%+2}=0 ! black Word{Mpal%+4}=0 ! black Word{Mpal%+6}=1000 ! white Word{Mpal%+8}=1000 Word{Mpal%+10}=1000 ' *~C:Clrblk%(L:Mf1%,L:72) ! effacer ' If Mf1%>0 ' B&=-1 ! tester tout If Flag! B&=@Rim_sel(True,Rim%,"RIMs","G‚n‚ration image",1) ! -2 si erreur Else if And(@Bios11,&X1100)<>0 B&=@Rim_sel(True,Rim%,"RIMs","Format de l'image",0) ! -2 si erreur Endif ' If B&<>-2 If Rim%>0 If Long{Rim%}<1000 ' A%=Rim%+4 If B&>0 For A&=0 To B&-1 Add A%,Long{A%}+4 Next A& Endif ' W&=Work_out(0)+1 H&=Work_out(1)+1 ' Select Word{A%+16} Case 0,1 ' A$="\*.*" ' If B&=>0 Select Byte{A%+24+4} Case "A" To "Z","0" To "9","_","a" To "z" Select Byte{A%+24+4+1} Case "A" To "Z","0" To "9","_","a" To "z" Select Byte{A%+24+4+2} Case "A" To "Z","0" To "9","_","a" To "z" If Byte{A%+24+4+3}=32 If Byte{A%+24+4+4}=Asc("-") If Byte{A%+24+4+5}=32 A$="\*."+Chr$(Byte{A%+24+4})+Chr$(Byte{A%+24+4+$ And And And And Imp $+Chr$(Byte{A%+24+$ And And And And Eqv Or +2}) Endif Endif Endif Endselect Endselect Endselect Endif ' File$=@Fsel$(A$,File$(5),"Charger image") @W_rdexe If Len(File$)>0 If @Exist(File$) File$(5)=File$ ' @Comp.info("B","Chargement du dessin") Gosub Defmouse(2) Open "i",#1,File$ Len%=Lof(#1) Adr%=@Malloc(Len%) Close #1 If Adr%>0 Ext$=Right$(File$,4) File$=File$+Chr$(0) H%=Gemdos(61,L:V:File$,W:0) If H%=>0 E%=Gemdos(63,H%,L:Len%,L:Adr%) ' Bget #1,Adr%,Len% ' Close #1 Gosub Defmouse(0) Else ~@Form_alert(1,"[3][|Erreur fichier "+Str$(H%)+" |][ Annuler ]") B&=-2 Endif Else ' Close #1 Gosub Defmouse(0) ~@Form_alert(1,"[3][|Plus de m‚moire disponible!|][ Annuler ]") @Comp.info("B","plus de m‚moire disponible ("+Str$(Malloc(-1))+")") B&=-2 Endif Else If Right$(File$,1)="\" Or Right$(File$,3)="\.*" Bit_uninit Gosub Defmouse(0) ~@Form_alert(1,"[3][|M‚moire lib‚r‚e!|][Confirmer]") @Comp.info("B","m‚moire lib‚r‚e") B&=-2 Else ~@Form_alert(1,@Errf$(-33)) @Comp.info("B","fichier non trouv‚") B&=-2 Endif Endif Else B&=-2 Endif ' Case 2 ! g‚n‚rant donnant les coordonn‚es Clr Adr%,Len% Ext$="_RIM" ' A$=Str$(W&)+" "+Str$(H&) Do A$=@Rinput$("Largeur et hauteur (www hhh)",A$) A$=Trim$(Upper$(A$)) If Len(A$)>0 C&=1 For A&=1 To Len(A$) $S& Select Mid$(A$,A&,1) Case "0" To "9","A" To "F","$","%","&","H","X","B","O" Case " " If C&=1 Clr C& Else C&=1 Exit if True Endif Endselect $S% Next A& If C&=0 ' C&=Instr(A$," ") If C&>0 If Val?(Left$(A$,C&-1))=C&-1 If Val?(Mid$(A$,C&+1))=Len(A$)-C& W&=Val(Left$(A$,C&-1)) H&=Val(Mid$(A$,C&+1)) If W&>0 And H&>0 And W&<9999 And H&<9999 C&=0 Else C&=1 Endif Else C&=1 Endif Else C&=1 Endif Else C&=1 Endif ' Endif Else B&=-2 Exit if True Endif Loop until C&=0 ' Case 3 Ext$="_RIM" Clr Adr%,Len% ' Default B&=-2 ! erreur! Endselect ' ~@Wind_update01(1) ' If B&<>-2 @Menu.info("Test format") A%=Rim%+4 For A&=0 To Long{Rim%} ' Exit if Long{A%}=0 ! fin ' If Imp(B&<>-1,A&=B&) ! si 1 seul If Long{A%+4}=Cvl("READ") If Long{A%+8}=Cvl("_IMG") Select Long{A%+12} Case "_VDI","_SHI","_VSH" Select Word{A%+16} Case 0,1,2,3 ' Gosub Defmouse(2) ' @Fmshow("Test format: "+Char{A%+24+4}) ' For A&=0 To 19 Byte{Mf1%+A&}=0 Next A& Word{Mf1%+4}=W& Word{Mf1%+6}=H& If Mod(W&,16)=0 Word{Mf1%+8}=W&\16 Else Word{Mf1%+8}=W&\16+$ And And And And Imp $ And + And Err$( Endif Select Long{A%+12} Case "_VDI","_VSH" Word{Mf1%+10}=1 Case "_SHI" Word{Mf1%+10}=0 Endselect ' Word{Mf1%+12}=Plans& ! resol actuelle Word{Mf1%+12}=1 ! monochrome! ' Word{Mf1%+18}=H% ! AGHHHHHHHH !!!! ' ' *** Test file *** R%=A%+56+4 E%=C:R%(W:0,L:Adr%,L:Len%,L:Len%,L:Cvl(Ext$),L:Mf1%) W&=Word{Mf1%+4} H&=Word{Mf1%+6} ' Select E% Case 0 If B&<>-1 ~@Form_alert(1,"[3][|Erreur, image non reconnue |][ Annuler ]") @Comp.info("B","image non reconnue") Endif Case -2 ! cancel Case 1 Select Word{A%+16} Case 2,3 ~@Form_alert(1,"[3][|Erreur RIM image|(donn‚es)|][ Annuler ]") @Comp.info("B","erreur RIM") Endselect Case 2,3 ! ok ' Exdo!=True @Menu.info("Traitement import: "+Char{A%+24+4}) ' Select Word{Mf1%+12} ! plans Case 1 ! mono ' N&=2 Clr N& Case 2 ! 4 col N&=4 Case 4 ! 16 col N&=16 Case 8 ! 256 col N&=256 Default Clr N& ! couleur=0 (err, pas de-) Endselect ' If N&>0 ! octets pour la palette Pal%=@Malloc(N&*6) ! R,V,B sur 2 octets = 6 octets par couleur If Pal%<=0 ~Form_alert(1,"[3][|Plus de m‚moire disponible!|(palette)|][ Annuler ]") @Comp.info("B","plus de m‚moire disponible pour palette ("+Str$(Malloc(-1))+")") Endif Else Clr Pal% ! pas de palette Endif ' @W_rdexe ! rim g‚n‚ ' ' *** Get palette *** (mˆme si il n'y en a pas! -> r‚cup‚rer taille etc..) B%=Adr%+Long{Mf1%} ! adresse+seek palette C%=Long{Mf1%+14} ! taille palette source #14.L Long{Mf1%}=Len% ! communiquer taille sur disque dans #0.L R%=A%+60+4 ! routine If (C:R%(W:0,L:B%,L:C%,L:Pal%,L:N&,L:Mf1%))<>2 ' ~Form_alert(1,"[3][|Erreur … la g‚n‚ration de |la palette|][ Annuler ]") E%=3 ! charger standard Endif ' ' If Pal%>0 ! construire palette Long{Pal%}=Cvl("DOIT") If E%=3 @Menu.info("cr‚ation d'une palette "+Str$(Word{Mf1%+12})+" plans") Select Word{Mf1%+12} Case 2,4,8 A$=Parx$(4)+"PARX.P"+Hex$(Word{Mf1%+12},2) If @Exist(A$) Open "I",#1,A$ If Lof(#1)=N&*6+8+4 Seek #1,10 If Inp&(#1)=Word{Mf1%+12} ! mˆmes plans Seek #1,8+4 Bget #1,Pal%,N&*6 ! charger Else ~Form_alert(1,"[3][|Erreur au chargement de la palette|(erreur?!)|][ Annuler ]") @Comp.info("B","erreur fichier palette") Endif Else ~Form_alert(1,"[3][|Erreur au chargement de la palette|(type?!)|][ Annuler ]") @Comp.info("B","erreur fichier palette") Endif Close #1 Else ' ~Form_alert(1,"[3][|Erreur au chargement de la palette|non trouv‚e |"+Right$(A$,28)+"][ Annuler ]") @Menu.info("palette non trouv‚e") Endif ' If Long{Pal%}=Cvl("DOIT") ! do it!! @Menu.info("palette "+Str$(Word{Mf1%+12})+" plans VDI cr‚‚e") For Z&=0 To N&-1 Contrl(0)=26 Contrl(1)=0 Contrl(3)=2 Contrl(6)=V~h Intin(0)=Z& Intin(1)=0 Vdisys Word{Pal%+Z&*6}=Intout(1) Word{Pal%+Z&*6+2}=Intout(2) Word{Pal%+Z&*6+4}=Intout(3) Next Z& Endif ' Case 1 Word{Pal%}=0 ! black Word{Pal%+2}=0 ! black Word{Pal%+4}=0 ! black Word{Pal%+6}=1000 ! white Word{Pal%+8}=1000 Word{Pal%+10}=1000 Endselect Endif Endif ' S%=Long{Mf1%} ! seek T%=Long{Mf1%+14} ! long. m‚moire … r‚server en plus (quel merdier) ' ' … SE r‚server! M%=@Malloc(Word{Mf1%+6}*ElseMf1%+8}*2*Word{Mf1%+12}) ' If T%<=0 Clr M2% Else M2%=@Malloc(T%) ! r‚server pour image (couleur ou mono) If M2%>0 ' *~C:Clrblk%(L:M2%,L:T%) ! effacer Else ~@Mfree(M%) Clr M% Endif Endif ' If M%>0 ' @Menu.info("G‚n‚ration de l'image") ' *** Do file *** ' *~C:Clrblk%(L:M%,L:Word{Mf1%+6}*Word{Mf1%+8}*2*Word{Mf1%+12}) B%=Adr%+S% ! adresse+seek Long{Mf1%}=M% ! adresse buffer destination R%=A%+64+4 ! do file Select C:R%(W:0,L:B%,L:Len%-S%,L:Mf1%) Case 3 ! ok that's all good! ' If Word{Mf1%+12}=1 ! mono Bit_set(Word{Mf1%+4},Word{Mf1%+6}) If Bitmap%>0 ' Transfert! Swap M%,Bitmap% ' Bmove M%,Bitmap%,Word{Mf1%+6}*Word{Mf1%+8}*2*Word{Mf1%+12} A!=True Else ~Form_alert(1,"[3][|Plus de m‚moire disponible!|(image mono)][ Annuler ]") @Comp.info("B","plus de m‚moire disponible pour image finale ("+Str$(Malloc(-1))+")") Endif Exit if True Else ! va falloir tramer agh! ' If M%>0 ~@Wind_update01(0) Exdo!=True Gosub Defmouse(0) C&=@Rim_sel(False,Trm%,"TRMs","Type de tramage",0) ! -2 si erreur Gosub Defmouse(2) ~@Wind_update01(1) If C&=>0 @Menu.info("Tramage en cours") ' For A&=0 To 19 Byte{Mf2%+A&}=Byte{Mf1%+A&} Next A& Word{Mf2%+10}=Word{Mf1%+10} ! en mono VDI=SHI Word{Mf2%+12}=1 ! monochrome F&=Word{Mf1%+10} ! sauver format (0,1) ' ' *** Test Trame file *** R%=Trm%+&H7A6+2 E%=C:R%(W:0,W:C&+1,L:0,L:Mf1%,L:Pal%,L:Mf2%,L:Mpal%,W:&X10) If E%=>0 If E%>0 If E%=-1 ! Malloc all!! E%=Malloc(-1) Sub E%,Word{Mf1%+6}*Word{Mf1%+8}*2*Word{Mf1%+12}*3 E%=Max(33000,E%) Endif B%=@Malloc(E%) ' If B%>0 ' *~C:Clrblk%(L:B%,L:E%) ! effacer ' Endif Else B%=1 Endif If B%>0 If B%=1 Clr B% Endif ' If Word{Mf1%+10}<>F& ! format diff‚rent? Exdo!=True @Menu.info("Transfert vers format standard") Bitmap%=@Malloc(Word{Mf1%+6}*Word{Mf1%+8}*2*Word{Mf1%+12}) If Bitmap%>0 ' *~C:Clrblk%(L:Bitmap%,L:Word{Mf1%+6}*Word{Mf1%+8}*2*Word{Mf1%+12}) For A&=0 To 19 Byte{Mf3%+A&}=Byte{Mf1%+A&} Next A& Long{Mf3%}=Bitmap% Word{Mf3%+10}=Word{Mf1%+10} ! nouv format ' Long{Mf1%}=M% ! adresse Word{Mf1%+10}=F& ! anc format ' Contrl(0)=110 Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Contrl(7)=Word(Swap(Mf1%)) Contrl(8)=Word(Mf1%) Contrl(9)=Word(Swap(Mf3%)) Contrl(10)=Word(Mf3%) Vdisys ! transform form! ' Swap Bitmap%,M% ! on ‚change! ~@Mfree(Bitmap%) Long{Mf1%}=M% ! nouvelle adresse Word{Mf1%+10}=Word{Mf3%+10} ! nouv format ' Else ~@Mfree(M%) M%=-1 ~Form_alert(1,"[3][|Plus de m‚moire disponible!|(trnsf)][ Annuler ]") @Comp.info("B","plus de m‚moire disponible pour transfert ("+Str$(Malloc(-1))+")") Endif Endif ' ' If M%>0 Bit_uninit Bit_set(Word{Mf2%+4},Word{Mf2%+6}) If Bitmap%>0 Long{Mf2%}=Bitmap% R%=Trm%+&H7A6+2 ' ~Inp(2) ' *** Trame file *** E%=C:R%(W:1,W:C&+1,L:B%,L:Mf1%,L:Pal%,L:Mf2%,L:Mpal%,W:&X10) If E%<0 ~@Form_alert(1,"[1][|Tramage impossible!|#2|][ Annuler ]") Else A!=True ! ok ouf! Endif Else ~Form_alert(1,"[3][|Plus de m‚moire disponible!|(trns2)][ Annuler ]") @Comp.info("B","plus de m‚moire disponible pour tramage ("+Str$(Malloc(-1))+")") Endif Endif Else ~Form_alert(1,"[3][|Plus de m‚moire disponible!|("+Str$(E%)+")][ Annuler ]") @Comp.info("B","plus de m‚moire disponible ("+Str$(Malloc(-1))+")") Endif If B%>0 ~@Mfree(B%) B%=-1 Endif Else ~@Form_alert(1,"[1][|Tramage impossible!|#1|][ Annuler ]") @Comp.info("B","tramage impossible") Endif Else ~@Form_alert(1,"[1][|Tramage annul‚|][ Annuler ]") @Comp.info("B",".. tramage annul‚") Endif Endif ' Endif Exit if True ' Default Endselect ' ' Else ~Form_alert(1, f@dÐè&!Èp fô#èa!èd f$f$fˆ&faÐ>dè& ¸è&Ýùà )Double{\:[ As Min(Bin$()Mks$(Mkf$() Offset String$( Offset Trace$Cvs( With Mkf$()Mks$(Cvs(Bin$(Round(Trace$Cfloat(Cvs(Mki$( As Mkf$(,:Abs(+Str$(T%)+")][ Annuler ]") @Comp.info("B","plus de m‚moire disponible ("+Str$(Malloc(-1))+")") Exit if True Endif ' Endselect ' Endselect Endselect Endif Endif Endif ' If M%>0 ~@Mfree(M%) Endif If M%>0 ~@Mfree(M2%) Endif If Pal%>0 ~@Mfree(Pal%) Endif ' Exit if Rim%<=0 ' Add A%,Long{A%}+4 If A%>Rim%+Rsiz% ! gasp!! ~Form_alert(1,"[3][|Erreur interne SRM-#2 |][ Annuler ]") @Comp.info("B","* erreur g‚n‚rale") ~@Mfree(Rim%) Rim%=-1 Exit if True Endif Next A& ' If M%>0 ~@Mfree(M%) Endif If M2%>0 ~@Mfree(M2%) Endif If Pal%>0 ~@Mfree(Pal%) Endif ' If Rim%>0 If (Not A!) And (A&=Long{Rim%}) ~@Form_alert(1,"[3][|Format d'image inconnu |][ Annuler ]") Endif Endif If Adr%>0 ~@Mfree(Adr%) Adr%=-1 Endif ' Endif Gosub Defmouse(0) ' If Wopen!(6) Pic_x&=-1 Rdw_all(6) Endif ~@Wind_update01(0) ' Else ~Form_alert(1,"[3][|Erreur interne SRM |][ Annuler ]") @Comp.info("B","* erreur g‚n‚rale") ~@Mfree(Rim%) Rim%=-1 Endif ' Else ~Form_alert(1,"[3][|Pas de RIMs PARX charg‚s!|][ Annuler ]") @Comp.info("B","* pas de RIMs charg‚s!") Endif Endif ! cancel ~@Mfree(Mf1%) Mf1%=-1 Mf2%=-1 Mpal%=-1 Else ~Form_alert(1,)Double{\:[ As Min(Bin$()Mks$(Mkf$() Offset String$( Offset Trace$Cvs( With Mkf$()Mks$(Cvs(Bin$(Round(Trace$Cfloat(Cvs(Mki$( As Mkf$(,:Double{\)Asin(Cfloat(Cfloat(Min( As Mkf$( With )Double{) @Comp.info("B","plus de m‚moire disponible ("+Str$(Malloc(-1))+")") Endif ' If H%=>0 E%=Gemdos(62,H%) Endif ' If Bitmap%>0 And A! Gosub Menu.info("") If Len(File$)>0 ~@Titlew(6,Right$(File$,20)+" - "+Name$) Endif Endif @Comp.info("","") @Test_menu ' Return ' Function Rim_sel(Flag!,R%,T$,E$,D&) $F% Local B& Local A$ Local A% Local A&,C&,N& Local X$ Local C% ' ' B&=-2 ' If R%>0 Clr B& Exdo!=True ' Char{Ob_spec(Adr%(Parxd&),Px_path&)}=Right$(Parx$,30) Char{Ob_spec(Adr%(Parxd&),Px_info&)}=E$+":" For A&=Px_first& To Px_last& Char{Ob_spec(Adr%(Parxd&),A&)}="" Next A& For A&=Px_conf& To Px_conflast& Ob_flags(Adr%(Parxd&),A&)=Bset(Ob_flags(Adr%(Parxd&),A&),7) Next A& ~@Form_wdo(Parxd&,-2) ! draw Clr B&,C& If D&=1 A%=R%+4 For A&=0 To Max(0,Long{R%}-8) Select Word{A%+4+12} Case 2,3 Exit if True Default Inc C& Endselect Add A%,Long{A%}+4 Next A& Endif B&=C& Do ' For A&=Px_first& To Px_last& Char{Ob_spec(Adr%(Parxd&),A&)}="" Next A& For A&=Px_conf& To Px_conflast& Ob_flags(Adr%(Parxd&),A&)=Bset(Ob_flags(Adr%(Parxd&),A&),7) Next A& If R%>0 If Flag! ! RIM/WIM A%=R%+4 For A&=0 To Min(B&+7,Long{R%}) If A&=>B& If Btst(Byte{A%+4+24+31},0) ! Config! Ob_flags(Adr%(Parxd&),Px_conf&+A&-B&)=Bclr(Ob_flags(Adr%(Parxd&),Px_conf&+A&-B&),7) Else Ob_flags(Adr%(Parxd&),Px_conf&+A&-B&)=Bset(Ob_flags(Adr%(Parxd&),Px_conf&+A&-B&),7) Endif Select D& Case 1 Select Word{A%+4+12} Case 2,3 A$=Left$(Char{A%+24+$ And And And And Eqv Or },30) A$=A$+Space$(30-Len(A$)) Char{Ob_spec(Adr%(Parxd&),Px_first&+A&-B&)}=A$ Endselect Default A$=Left$(Char{A%+24+4},30) A$=A$+Space$(30-Len(A$)) Char{Ob_spec(Adr%(Parxd&),Px_first&+A&-B&)}=A$ Endselect Endif Add A%,Long{A%}+4 Next A& ' Else ! TRM ' A%=R%+&H7A6+2+$ And And And And Eqv Or ! data+bra.l For A&=0 To Min(B&+7,Word{R%+&H7A6}-1) If A&=>B& A$=Left$(Char{A%},30) A$=A$+Space$(30-Len(A$)) Char{Ob_spec(Adr%(Parxd&),Px_first&+A&-B&)}=A$ Endif Add A%,32 Next A& Endif Else Char{Ob_spec(Adr%(Parxd&),Px_first&)}="Pas de "+T$+" charg‚s" Char{Ob_spec(Adr%(Parxd&),Px_first&+1)}="Red‚finissez le chemin" Endif ~Objc_draw(Adr%(Parxd&),Px_first&-1,7,Rx&(Parxd&),Ry&(Parxd&),Rw&(Parxd&),Rh&(Parxd&)) ~Objc_draw(Adr%(Parxd&),Px_conf&-1,7,Rx&(Parxd&),Ry&(Parxd&),Rw&(Parxd&),Rh&(Parxd&)) ' A&=Byte(@Form_wdo(Parxd&,0)) Ob_state(Adr%(Parxd&),A&)=Bclr(Ob_state(Adr%(Parxd&),A&),0) Select A& Case Px_can&,0,1 B&=-2 Exit if True Case Px_up& If R%>0 B&=Max(C&,B&-7) Endif Case Px_dwn& If R%>0 If Flag! B&=Max(0,Min(B&+7,Long{R%}-8)) Else B&=Max(0,Min(B&+7,Word{R%+3180}-8)) Endif Endif ' Case Px_path& ' ~@Form_wdo(Parxd&,-3) ' Parx$="!" ' Gosub Rim_init ' Char{Ob_spec(Adr%(Parxd&),Px_path&)}=Right$(Parx$,30) ' Exdo!=True ' ~@Form_wdo(Parxd&,-2) ! draw ' Clr B& ' If Rim%=0 ' ' B&=-2 ! erreur! ' ' Exit if True ' Clr R% ' Else ' B&=-2 ' Exit if True ' Endif ' Case Px_conf& To Px_conflast& A%=R%+4 If Min(B&+A&-Px_conf&-1,Long{R%})=>0 For N&=0 To Min(B&+A&-Px_conf&-1,Long{R%}) Add A%,Long{A%}+4 Next N& Endif ' If Btst(Byte{A%+4+24+31},0) ! Config! C%=A%+4+24+30+2 ! POINTE SUR 1E ROUTINE Select Left$(T$,3) Case "RIM","WIM" Add C%,4*(4-1) ! 4e routine RIM/WIM Case "IFX" Add C%,4*(2-1) ! 2e routine IFX Default Clr C% Endselect If C%>0 X$=Parx$+Mki$(0) @Showm Select C:C%(W:1,L:V:X$) ! Config Case 0 Case -1 ~@Form_alert(1,"[3][|Erreur "+T$+"|Configuration impossible|][Annuler]") Case -2 ~@Form_alert(1,"[3][|Erreur "+T$+"|Configuration erron‚e|][Annuler]") Endselect Endif Endif ' Case Px_first& To Px_last& If R%>0 B&=B&+(A&-Px_first&) ! charger xx If Flag! If B&<=Long{R%} Exit if True Else B&=B&-(A&-Px_first&) ! charger xx @Beep Endif Else ! TRM ' ' If B&<=Word{R%+3180} If B&<=Word{R%+&H7A6}-1 Exit if True Else B&=B&-(A&-Px_first&) ! charger xx @Beep Endif Endif Else If Form_alert(1,"[3][|Pas de "+T$+" PARX charg‚s!|Red‚finissez le chemin!|][Confirmer| Annuler ]")=1 ~@Form_wdo(Parxd&,-3) Parx$="!" Gosub Rim_init ' Char{Ob_spec(Adr%(Parxd&),Px_path&)}=Right$(Parx$,30) Exdo!=True ~@Form_wdo(Parxd&,-2) ! draw B&=-2 Exit if True Endif Endif Endselect Loop ~@Form_wdo(Parxd&,-3) ' Return B& ' Else ' ~Form_alert(1,"[3][|Pas de "+T$+" PARX charg‚s!|][ Annuler ]") ' Endif ' Return B& Endfunc ' Procedure Rim_uninit If Rim%>0 ~@Mfree(Rim%) Endif If Wim%>0 ~@Mfree(Wim%) Endif If Trm%>0 R%=Trm%+&H7A6+2 ~C:R%(3,Abs(Px_card!),L:0,L:0,L:0,L:0,L:0,0) ' ~@Mfree(Trm%) Endif If Ifx%>0 ~@Mfree(Ifx%) Endif Return ' Procedure Ifx_do Local A&,B& Local A%,Mf1%,Mf2%,M%,R% ' If Bitmap%>0 If Ifx%>0 B&=@Rim_sel(True,Ifx%,"IFXs","Type d'effet",0) ! -2 si erreur If B&=>0 A%=Ifx%+4 If B&>0 For A&=0 To B&-1 Add A%,Long{A%}+4 Next A& Endif ' If Word{A%+12+4}=0 ! type 0 If Long{A%+4}=Cvl("IFX_") If Long{A%+4+4}=Cvl("_IMG") Select Long{A%+8+$ And And And And Eqv Or } Case "_VDI","_SHI","_VSH" ! c'est la mˆme chose en monochrome ' Mf1%=@Malloc(40) If Mf1%>0 Mf2%=Mf1%+20 For A&=0 To 19 Byte{Mf1%+A&}=0 ' Byte{Mf2%+A&}=0 Next A& @Comp.info("B","Effet: "+Char{A%+24+4}) ' Long{Mf1%}=Bitmap% Word{Mf1%+4}=Bitw& Word{Mf1%+6}=Bith& If Mod(Bitw&,16)=0 Word{Mf1%+8}=Bitw&\16 Else Word{Mf1%+8}=Bitw&\16+1 Endif Select Long{A%+8+4} Case "_VDI","_VSH" Word{Mf1%+10}=1 ! format vdi Word{Mf2%+10}=1 ! format vdi Case "_SHI" Word{Mf1%+10}=0 ! format shifter (=vdi en monochrome !!) Word{Mf2%+10}=0 ! format shifter (=vdi en monochrome !!) Endselect Word{Mf1%+12}=1 ! mono ' For A&=0 To 19 Byte{Mf2%+A&}=Byte{Mf1%+A&} Next A& ' ' ** Do ifx ** R%=A%+56+4 $S% Select C:R%(L:Mf1%,L:0,L:Mf2%,L:0) ! pas de palette Case -1 ~@Form_alert(1,"[3][|Erreur Ifx! |][ Annuler ]") Case 0 Bitw&=Word{Mf1%+4} Bith&=Word{Mf1%+6} Bitl&=Word{Mf1%+8}*2 ! bit line length (octets) ~@Infow(6,"Image: "+Str$(Bitw&)+"*"+Str$(Bith&)) Rdw_all(6) Case 1 ! r‚server m‚moire If Word{Mf2%+12}=1 ! monochrome! M%=@Malloc(Word{Mf2%+6}*Word{Mf2%+8}*2*Word{Mf2%+12}) ! r‚server! If M%>0 Long{Mf2%}=M% ! noter adresse R%=A%+56+$ And And And And Eqv Or If C:R%(L:Mf1%,L:0,L:Mf2%,L:0)=0 Bit_uninit Bit_set(Word{Mf2%+4},ElseMf2%+6}) If Bitmap%>0 Swap Bitmap%,M% Else ~@Form_alert(1,"[3][|Plus de m‚moire disponible!|(tampon)][ Annuler ]") Endif Else ~@Form_alert(1,"[3][|Erreur Ifx! |][ Annuler ]") Endif ' ~@Mfree(M%) Else ~@Form_alert(1,"[3][|Plus de m‚moire disponible!|(tampon)][ Annuler ]") Endif Else ~@Form_alert(1,"[3][|Erreur, effet couleur! |][ Annuler ]") Endif Rdw_all(6) Case 2 ! palette en plus!! ~@Form_alert(1,"[3][|Erreur palette! |][ Annuler ]") Endselect ' ~@Mfree(Mf1%) Else ~@Form_alert(1,"[3][|Plus de m‚moire disponible!|][ Annuler ]") Endif ' Default ~@Form_alert(1,"[3][|Type IFX inconnu |][ Annuler ]") Endselect Else ~@Form_alert(1,"[3][|Ce n'est pas un IFX |][ Annuler ]") Endif Else ~@Form_alert(1,"[3][|Ce n'est pas un IFX |][ Annuler ]") Endif Else ~@Form_alert(1,"[3][|Effet n‚cessitant 2 images|][ Annuler ]") Endif ' Endif ! cancel Else ~Form_alert(1,"[3][|Pas de IFXs PARX charg‚s!|][ Annuler ]") Endif Endif ! bitmap>0 Return ' ' Procedure Picline(X&,Y&) Local A% Local A& ' A&=@Wind_update01(-1) If A&=0 ' ..Verouillage du GEM ~@Wind_update01(1) Endif ' If X&=>W_ix&(6) And Y&=>W_iy&(6) And X&<=W_ix&(6)+W_iw&(6) And Y&<=W_iy&(6)+W_ih&(6) X&=@Wxrcoord(6,X&) Y&=@Wyrcoord(6,Y&) If X&=>0 And Y&=>0 And X&<=Bitw& And Y&<=Bith& Inc Pic_t& If Pic_t&>15 Clr Pic_t& Endif ' If X&<>Pic_x& Or Y&<>Pic_y& ' @Wind_clip(6) @Hidem Gosub Picl ! dessiner ligne pix ' Contrl(0)=113 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h A%=&X111111110000000011111111 Intin(0)=Shr(A%,Pic_t&) Vdisys ' Pic_x&=X& Pic_y&=Y& ' Gosub Picl ! dessiner ligne pix ' Gosub Defmouse(7) @Showm ' Endif Endif Else If Pic_x&<>-1 Gosub Defmouse(0) Wind_clip(6) ! clipping fenˆtre Graphmode (3) @Hidem Gosub Picl ! dessiner ligne pix @Showm Graphmode (1) Pic_x&=-1 Pic_y&=-1 Endif Endif If A&=0 ~@Wind_update01(0) Endif ' Return Procedure Picl If Pic_x&<>-1 Graphmode (3) Defline 7,1,0,0 @Lhidem ' If Pic_x&>16 And Pic_x&16 And Pic_y&0 ' Gosub Top(6) Gosub W_rdexe Wind_clip(6) ! clipping fenˆtre If Bm_x&=>0 Graphmode (3) Defline 4,1,0 @Box(@Wxacoord(6,Bm_x&),@Wyacoord(6,Bm_y&),@Wxacoord(6,Bm_x&)+Bm_w&-1,@Wyacoord(6,Bm_y&)+Bm_h&-1) Defline 0,1,0 Graphmode (1) Endif ' B!=True ! demander coord (b sera utilis‚ aussi par la suite) If X&=-1 ! reprendre last coord If Bm_x&=>0 X&=@Wxacoord(6,Bm_x&) Y&=@Wyacoord(6,Bm_y&) W2&=Bm_w& H2&=Bm_h& B!=False Endif Endif ' If B! If Bclr(@Bios11,5)<>0 X&=@Wxrcoord(6,X&) Y&=@Wyrcoord(6,Y&) If Mod(X&,8)<>0 X&=(X&\8)*8 Endif If Mod(Y&,8)<>0 Y&=(Y&\10)*10 Endif X&=@Wxacoord(6,X&) Y&=@Wyacoord(6,Y&) Endif ' If Pic_x&<>-1 Gosub Picl ! dessiner ligne pix Pic_x&=-1 Endif ' Gosub Defmouse(7) ' ' ~Graf_rubberbox(X&,Y&,1,1,W2&,H2&) Graphmode (3) Clr W3&,H3& @Hidem Gosub Box(X&,Y&,X&+W3&-1,Y&+H3&-1) @Showm Repeat Mouse W2&,H2&,N& ' W2&=Min(320,Max(0,W2&-X&+1)) H2&=Min(240,Max(0,H2&-Y&+1)) ' If Bclr(@Bios11,5)<>0 If Mod(W2&,8)<>0 W2&=(W2&\8+$ And And And And Imp $8 Endif If Mod(H2&,10)<>0 H2&=(H2&\10+1)*10 Endif Endif ' W2&=Min(W2&,Bitw&-@Wxrcoord(6,X&)) H2&=Min(H2&,Bith&-@Wyrcoord(6,Y&)) If W3&<>W2& Or H3&<>H2& @Hidem Gosub Box(X&,Y&,X&+W3&-1,Y&+H3&-1) Gosub Box(X&,Y&,X&+W2&-1,Y&+H2&-1) @Showm W3&=W2& H3&=H2& ~@Infow(6,"Coord: X= "+Str$(@Wxrcoord(6,X&))+" Y= "+Str$(@Wyrcoord(6,Y&))+" W= "+Str$(W2&)+" H= "+Str$(H2&)) Endif Until N&=0 @Hidem Gosub Box(X&,Y&,X&+W3&-1,Y&+H3&-1) @Showm Graphmode (1) Gosub Defmouse(0) Endif ' If (W2&>0 And H2&>0) And (W2&>1 Or H2&>1) ' Do ! BOUCLE si test!! C!=True ! pas de test ' Gosub Top(6) Gosub W_rdexe Gosub Wind_clip(6) @Hidem Gosub Deffill(1,1,1) Bndary(0) Graphmode ($ And And And And Eqv And ) Gosub Pbox(X&,Y&,X&+W2&-1,Y&+H2&-1) Graphmode (1) @Showm ' Bm_x&=@Wxrcoord(6,X&) ! noter! Bm_y&=@Wyrcoord(6,Y&) Bm_w&=W2& Bm_h&=H2& ' ' Clr E$ ! pas de trame de cod B!=False ! pas trame Exdo!=True Z&=-1 ! Pas de chargement ~@Wind_update01(0) Do A&=Byte(@Form_wdo(18,0)) If A&<>Dg_load& Ob_state(Adr%(18),A&)=Bclr(Ob_state(Adr%(18),A&),0) Endif ' Select A& Case Dg_video& ! graph normal Ob_flags(Adr%(18),Dg_drbox&)=Bset(Ob_flags(Adr%(18),Dg_drbox&),7) ' Ob_state(Adr%(18),Dg_video&)=Bset(Ob_state(Adr%(18),Dg_video&),0) Ob_state(Adr%(18),Dg_drcs&)=Bclr(Ob_state(Adr%(18),Dg_drcs&),0) ~Objc_draw(Adr%(18),0,255,Rx&(18),Ry&(18),Rw&(18),Rh&(18)) Case Dg_drcs& ! DRCS Ob_flags(Adr%(18),Dg_drbox&)=Bclr(Ob_flags(Adr%(18),Dg_drbox&),7) ' Ob_state(Adr%(18),Dg_drcs&)=Bset(Ob_state(Adr%(18),Dg_drcs&),0) Ob_state(Adr%(18),Dg_video&)=Bclr(Ob_state(Adr%(18),Dg_video&),0) ~Objc_draw(Adr%(18),0,255,Rx&(18),Ry&(18),Rw&(18),Rh&(18)) ' Case Dg_selp& ' ~form_dial(3,0,0,0,0,Rx&(18),Ry&(18),Rw&(18),Rh&(18)) ~@Form_wdo(18,-3) @W_rdexe ' E$=String$(188,&HFF) ! 94*2 Chs_set(False) ! ceux non utilis‚s B!=True ' E$=@Chsel$ Gosub Chsel("utiliser") Exdo!=True Gosub W_rdexe Case Dg_t&,Dg_f& ~@Form_wdo(18,-3) B&=@Col8 If B&=>0 If A&=Dg_t& Char{{Ob_spec(Adr%(18),Dg_t&)}}=@Colindex$(B&) Else Char{{Ob_spec(Adr%(18),Dg_f&)}}=@Colindex$(B&) Endif Endif ' Case Dg_x& ! pos ' Wherexy(B&,C&) ' Char{{Ob_spec(Adr%(18),Dg_x&)}}=Str$(B&) ' Char{{Ob_spec(Adr%(18),Dg_y&)}}=Str$(C&) ' ~Objc_draw(Adr%(18),Dg_x&,255,Rx&(18),Ry&(18),Rw&(18),Rh&(18)) ' ~Objc_draw(Adr%(18),Dg_y&,255,Rx&(18),Ry&(18),Rw&(18),Rh&(18)) Case Dg_load& If Not Btst(Ob_state(Adr%(18),Dg_load&),0) Ob_state(Adr%(18),Dg_load&)=Bclr(Ob_state(Adr%(18),Dg_load&),0) Ob_flags(Adr%(18),Dg_box&)=Bset(Ob_flags(Adr%(18),Dg_box&),7) Else Ob_state(Adr%(18),Dg_load&)=Bset(Ob_state(Adr%(18),Dg_load&),0) Ob_flags(Adr%(18),Dg_box&)=Bclr(Ob_flags(Adr%(18),Dg_box&),7) Endif ~Objc_draw(Adr%(18),Dg_load&,7,Rx&(18),Ry&(18),Rw&(18),Rh&(18)) ~Objc_draw(Adr%(18),0,7,Rx&(18),Ry&(18),Rw&(18),Rh&(18)) Case Dg_ok& C!=True ! exit aprŠs Exit if True Case Dg_tst& C!=False ! revenir et afficher Exit if True Case Dg_cancel&,0 Exit if True Endselect Loop ~@Form_wdo(18,-3) ' If A&=Dg_ok& Or A&=Dg_tst& ' ' col texte/fond T&=@Indexcol(Char{{Ob_spec(Adr%(18),Dg_t&)}}) F&=@Indexcol(Char{{Ob_spec(Adr%(18),Dg_f&)}}) ' If Btst(Ob_state(Adr%(18),Dg_back&),0) ! charger fond avant A!=True Else A!=False Endif ' ' position x et y X2&=Val(Char{{Ob_spec(Adr%(18),Dg_x&)}})-1 ! -1 pour X Y2&=Val(Char{{Ob_spec(Adr%(18),Dg_y&)}}) X2&=Max(0,Min(39,X2&)) Y2&=Max(0,Min(24,Y2&)) Char{{Ob_spec(Adr%(18),Dg_x&)}}=Str$(X2&+1,2) Char{{Ob_spec(Adr%(18),Dg_y&)}}=Str$(Y2&,2) ' If Btst(Ob_state(Adr%(18),Dg_eff&),0) Arrayfill Drcs|(),0 ! effacer! Endif ' ' ' ' If Btst(Ob_state(Adr%(18),Dg_1&),0) ' M&=0 ! codage normal ' Else if Btst(Ob_state(Adr%(18),Dg_1&),0) ' M&=1 ! ‚tendu ' Else ' M&=1 ! pas ecore install‚ ' Endif M&=Min(1,@State_pop(Adr%(18),Dg_1&)-1) ' ' Type de chargement If Btst(Ob_state(Adr%(18),Dg_load&),0) ' ' type de chargement de fonte Clr Z& Z&=Z& Or Rol(-Btst(Ob_state(Adr%(18),Dg_l1&),0),1) Z&=Z& Or (-Btst(Ob_state(Adr%(18),Dg_l2&),0)) ' ' ' Utilisation de polices? If Btst(Ob_state(Adr%(18),Dg_pol&),0) ' If Len(E$)=0 If Not B! ' E$=String$(188,&HFF) ! 94*2 Chs_set(False) ! idem ' E$=@Chsel$ Gosub Chsel("utiliser") For D|=0 To 1 For C|=0 To 93 ' If Asc(Mid$(E$,C|+D|*94+1,1))=&HFF ! utiliser? If Keep|(C|+D|*94)=0 ! utiliser? For E|=0 To 9 Drcs|(D|,C|,E|)=0 ! clear Next E| Endif Next C| Next D| Endif ' Else ! on peut tout utiliser! ' E$=String$(188,&HFF) Arrayfill Drcs|(),&H0 Arrayfill Keep|(),0 Endif ' Else ! ne pas charger Z&=-1 ' E$=String$(188,&HFF) Arrayfill Drcs|(),&H0 Arrayfill Keep|(),0 Endif ' Endif ' @Hidem Gosub Deffill(1,1,1) Bndary(0) Graphmode ($ And And And And Eqv And ) @Wind_clip(6) Gosub Pbox(X&,Y&,X&+W2&-1,Y&+H2&-1) Graphmode (1) @Showm ' ' ~form_dial(3,0,0,0,0,Rx&(18),Ry&(18),Rw&(18),Rh&(18)) ~@Form_wdo(18,-3) Gosub W_rdexe ' If A&=Dg_ok& Or A&=Dg_tst& ! ok? on digitalise! If Not C! A&=Actb& Actb&=6 ! 7e bloc r‚serv‚ Endif Drtrans(T&,F&,Z&,A!,M&,X2&,Y2&,X&,Y&,W2&,H2&) If Not C! Gosub Z_send ' Binair$(6)="" ! effacer 7e bloc Actb&=A& Endif Endif ' ~@Wind_update01(0) Gosub Defmouse(0) Pic_x&=-1 Rdw_all(6) ' Loop until C! ' Else ! redssin If Bm_x&=>0 @Wind_clip(6) Graphmode (3) Defline 4,1,0 @Box(@Wxacoord(6,Bm_x&),@Wyacoord(6,Bm_y&),@Wxacoord(6,Bm_x&)+Bm_w&-1,@Wyacoord(6,Bm_y&)+Bm_h&-1) Defline 0,1,0 Graphmode (1) Endif Endif ! trop petit ' Else Gosub Load.bit(0) ! charger image! ' Endif ! bitmap>0? ' Return ' Function Indexcol(E$) $F% ' $S% Select Upper$(E$) Case "NOIR" Return 0 Case "BLEU" Return 1 Case "ROUG" Return 2 Case "MAGE" Return 3 Case "VERT" Return 4 Case "CYAN" Return 5 Case "JAUN" Return 6 Case "BLAN" Return 7 Endselect ' Return 0 Endfunc Function Colindex$(N&) Select N& Case 0 Return "Noir " Case 1 Return "Bleu " Case 2 Return "Rouge " Case 3 Return "Magenta " Case 4 Return "Vert " Case 5 Return "Cyan " Case 6 Return "Jaune " Case 7 Return "Blanc " Endselect Return "Blanc " Endfunc ' ' envoi imm‚diat du buffer Procedure Z_send Local A% ' If Redir! @Top(4) Wind_clip(4) ! clipper fenˆtre 4 @W_rdexe @Vcls(True) Endif Send(Cls$) A%=1 Do @Hidem Send(Mid$(Binair$(Actb&),A%,16)) @Showm If Inp?(2) Or @Mousek<>0 @Videkbd ~@Wind_update01(0) Exit if @Form_alert(2,"[3][|"+"Interrompre le transfert? |][Confirmer| Annuler ]")=1 ~@Wind_update01(1) Endif ' Add A%,16 Loop until A%>Len(Binair$(Actb&))+15 Return ' ' Options Procedure Pixdefs Local A& ' Exdo!=True A&=Byte(@Form_wdo(Digitype&,0)) Ob_state(Adr%(Digitype&),A&)=Bclr(Ob_state(Adr%(Digitype&),A&),0) ' ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(Digitype&),Ry&(Digitype&),Rw&(Digitype&),Rh&(Digitype&)) ~@Form_wdo(Digitype&,-3) Gosub W_rdexe ' $S& Select A& Case Dg3_load&,Dg3_acq& @Lhidem Wind_clip(6) ! clipping fenˆtre Picline(-1,-1) If Bm_x&=>0 Graphmode (3) Defline 4,1,0 @Box(@Wxacoord(6,Bm_x&),@Wyacoord(6,Bm_y&),@Wxacoord(6,Bm_x&)+Bm_w&-1,@Wyacoord(6,Bm_y&)+Bm_h&-1) Defline 0,1,0 Graphmode (1) Endif @Lshowm If A&=Dg3_acq& Gosub Load.bit(True) Else Gosub Load.bit(0) Endif Case Dg3_ifx& ! effets! Gosub Ifx_do Endselect $S% ' Return ' Procedure Drtrans(T&,F&,Z&,A!,M&,X2&,Y2&,X&,Y&,W&,H&) Local E%,M% Local W2& Local H2& Local M&,N& ! status, nbr car ' X&=@Wxrcoord(6,X&) Y&=@Wyrcoord(6,Y&) ' If Mod(W&,16)<>0 W2&=(W&\16+1)*16 Else W2&=W& Endif If Mod(H&,10)<>0 H2&=(H&\10+1)*10 Else H2&=H& Endif M%=@Malloc(W2&*H2&\8) ' *~C:Clrblk%(L:M%,L:W2&*H2&\8) ' If M%>0 ' G_s%(0)=Bitmap% G_s%(1)=Bitw& G_s%(2)=Bith& G_s%(3)=Bitl&\2 G_s%(4)=0 G_s%(5)=1 ' G_s2%(0)=M% G_s2%(1)=W2& G_s2%(2)=H2& G_s2%(3)=G_s2%(1)\16 G_s2%(4)=0 G_s2%(5)=1 ' R_d%(0)=X& R_d%(1)=Y& R_d%(2)=X&+W&-1 R_d%(3)=Y&+H&-1 R_d%(4)=0 R_d%(5)=0 R_d%(6)=W&-1 R_d%(7)=H&-1 R_d%(8)=3 ' Bitblt G_s%(),G_s2%(),R_d%() ! Vdi Raster Copy ; Opaque ' If Mod(W&,8)<>0 W&=(W&\8+1)*8 Endif If Mod(H&,10)<>0 H&=(H&\10+1)*10 Endif ' ' Dim Keep|(188) ' Arrayfill Keep|(),0 Binair$(Actb&)=String$(32700,0) ~Fre(0) ' Print At(1,1);"gmtel: $";Hex$(M%,8);" ";W2&;" ";H2&;" ";Hex$(V:Binair$(Actb&),8);" ";32000;" ";0;" ";0;" ";W&\8;" ";H&\10;" ";Z&;" 1 ";T&;" ";F&;" ";X2&;" ";Y2&;" ";W&\8;" ";H&\10;" ";" $";Hex$(V:Drcs|(0,0,0),8);" $";Hex$(V:Keep|(0),8),,, ' If M&=0 E%=@Ctrans(M%,W2&,H2&,V:Binair$(Actb&),32000,0,0,W&\8,H&\10,Z&,Abs(A!),T&,F&,X2&,Y2&,W&\8,H&\10,V:Drcs|(0,0,0),V:Keep|(0),V:M&,V:N&) ' Else ' Endif ' If E%>0 If M&=0 ~@Infow(6,"Bloc trait‚ int‚gralement, "+Str$(N&)+" car. DRCS") Else ~@Infow(6,"Bloc non trait‚ int‚gralement, "+Str$(N&)+" car. DRCS") Endif Else ~@Infow(6,"Bloc image vide ou erreur") Endif ' ' Print "return:";E%,, ' Erase Keep|() If E%=-1 ~@Form_alert(1, f@dÐè&!Èp fô#èa!èd f$f$fˆ&faÐ>dè& ¸è&Ýùà )Double{\:= With With Mkf$(Min( With )Mks$(Mkf$()Mkl$(Trace$Mks$(Char{Deg(Mkf$(:Double{\}=Trace$Cfloat(Mkd$(Cvs( With Offset Mkf$( With Double{) Else Binair$(Actb&)=Left$(Binair$(Actb&),E%) Endif ~Fre(0) ~@Mfree(M%) M%=-1 Rdw_all(5) ' Else ~Form_alert(1,"[3][|Plus de m‚moire disponible][ Annuler ]") Endif ' Return ' ' routine C, de Sweetel 2.003, environ 10 … 20 fois plus rapide, plus souple et plus maniable Function Ctrans(Adr2%,W2&,H2&,Adr%,L&,X&,Y&,W&,H&,Z&,C&,T&,F&,X2&,Y2&,W3&,H3&,A%,B%,M%,N%) $X gmtel Long{Adr%}=Cvl("ERR,") Long{Adr%+4}=Cvl("C + ") Return 8 Endfunc ' ~Form_alert(1,"[3][|Error C|][Confirmer]") ' Procedure Emclip(Mx&,My&) Local X&,Y&,P&,Mx2&,My2&,A&,S&,X2&,Y2& Local P$,File$ Local A! ' X2&=X_curs& Y2&=Y_curs& ' Gosub Defmouse(1) @Vcurs(False) Wind_clip(4) ! clipping fenˆtre ' ~@Infow(4,"Couper.. [SHIFT] : supprimer car. graphiques") ' Mx&=@Wxrcoord(4,Mx&)-Emx& My&=@Wyrcoord(4,My&)-Emy& Mx&=Mx&\Eccsizex& My&=My&\Eccsizey& Mx&=Max(0,Mx&) My&=Max(0,My&) Mx&=Min(Mx&,Vmax_x&) My&=Min(My&,Vmax_y&) X_curs&=Mx& Y_curs&=My& ' Mx&=@Wxacoord(4,Mx&*Eccsizex&+Emx&) My&=@Wyacoord(4,My&*Eccsizey&+Emy&) Clr Mx2&,My2& ' W&=(@Wxrcoord(4,Mx&)-Emx&)\Eccsizex& H&=(@Wyrcoord(4,My&)-Emy&)\Eccsizey& ' @Hidem Graphmode (3) Mouse Mx2&,My2&,P& Gosub Pbox(Mx&,My&,Mx2&,My2&) Graphmode (1) @Showm Repeat Mouse X&,Y&,P& X&=(Min(Vmax_x&-W&+1,Max((X&-Mx&)\Eccsizex&,1)))*Eccsizex&+Mx& Y&=(Min(Vmax_y&-H&+1,Max((Y&-My&)\Eccsizey&,1)))*Eccsizey&+My& ' If X&<>Mx2& Or Y&<>My2& @Lhidem Graphmode (3) Gosub Pbox(Mx&,My&,Mx2&,My2&) Gosub Pbox(Mx&,My&,X&,Y&) Graphmode (1) @Lshowm ' Mx2&=X& My2&=Y& Endif Until P&<>1 @Lhidem Graphmode (3) Gosub Pbox(Mx&,My&,X&,Y&) Graphmode (1) @Lshowm Mx2&=(@Wxrcoord(4,Mx2&)-Emx&)\Eccsizex&-W& My2&=(@Wyrcoord(4,My2&)-Emy&)\Eccsizey&-H& Mx&=W& My&=H& ' Gosub Defmouse(0) If P&=0 And Mx2&>2 And My2&=>1 And (Mx2&*My2&)>4 ' A!=(And(@Bios11,&X11)<>0) ' If Scrp_read(P$)<>1 File$=@Fsel$("\*.",File$(2),"Sauver txt/vdt ") If Rinstr(File$,".")>0 File$=Left$(File$,Rinstr(File$,".")-1) Endif Else File$=P$ Endif Clr P$ ' If Len(File$)>0 ' A&=@Form_alert(1,"[3][|Couper bloc.. |][Texte|Vid‚otex|Annuler]") ' ~@Infow(4,"Coller..") Gosub Defmouse(2) S&=Actb& Actb&=6 ' Binair$(Actb&)=@Miniblock$(Mx&,My&,Mx2&,My2&) Binair$(Actb&)="" Clr P$ For Y&=My& To My&+My2&-1 Clr P$ For X&=Mx& To Mx&+Mx2&-1 If A! If Not Btst(Vida|(X&,Y&),4) P$=P$+Chr$(Vids&(X&,Y&)) Else P$=P$+" " Endif Else P$=P$+Chr$(Vids&(X&,Y&)) Endif Next X& P$=">"+P$ P$=Mid$(Trim$(P$),2) Binair$(Actb&)=Binair$(Actb&)+P$+Cr$ Next Y& ' Gosub Defmouse(2) Open "O",#1,File$+"SCRAP.TXT" Print #1,Binair$(Actb&); Close #1 ' ' Fichier "ajout" If @Exist(File$+"SCRAP.1ST") Open "U",#1,File$+"SCRAP.1ST" Seek #1,Lof(#1) Else Open "O",#1,File$+"SCRAP.1ST" Endif ' Print #1,Cr$; Print #1,Binair$(Actb&); Close #1 ' Binair$(Actb&)="" Binair$(Actb&)=@Miniblock$(Mx&,My&,Mx2&,My2&) Open "O",#1,File$+"SCRAP.VDT" Print #1,Binair$(Actb&); Close #1 Gosub Defmouse(0) ' ' Binair$(Actb&)="" Actb&=S& Gosub Defmouse(0) ' ~@Infow(4,"Bloc sauv‚ SCRAP.TXT SCRAP.1ST SCRAP.VDT") ' Else Gosub Drawx(4) Endif Else Gosub Drawx(4) Endif ' X_curs&=X2& Y_curs&=Y2& @Vcurs(True) @Caremouse Gosub Defmouse(0) Return ' ' ' /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ ' MiniDraw 1.0 - ½Xavier ROCHE 1993 ' /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ ' ' Traitement clavier.. Procedure Minikey(Key&) ' @Hidem @Vcurs(False) If Not Set_minid! $S& Select Key& Case 8 Gosub Emanage(True,8) Gosub Emanage(True,32) Gosub Emanage(True,8) Case 13 Gosub Emanage(True,13) Gosub Emanage(True,10) Case 27 @Minitr ! traiter s‚quance Case 200 ! haut Gosub Emanage(True,11) Case 208 ! bas Gosub Emanage(True,27) Gosub Emanage(True,91) Gosub Emanage(True,&H42) If Y_curs&>Vmax_y& Vmax_x&=1 Endif Case 205 ! droite Gosub Emanage(True,9) Case 203 ! gauche Gosub Emanage(True,8) Case 127 Gosub Emanage(True,27) Gosub Emanage(True,91) Gosub Emanage(True,&H50) Case 199 ! home! Gosub Emanage(True,30) Case 210 ! insert Gosub Emanage(True,27) Gosub Emanage(True,91) Gosub Emanage(True,76) Case 25 ! ^Y Gosub Emanage(True,27) Gosub Emanage(True,91) Gosub Emanage(True,77) Case 127 To Gosub Emanage(True,Key&) Case 32 To Gosub Minichar(Key&) Default Beep Endselect $S% Restore_4!=True Else $S& Select Key& Case 8 Gosub Seg_del Case 27 Gosub Seg_clr Case 13 Gosub Seg_exe Default @Showm ~@Form_alert(1,"[3][|Vous ˆtes en mode de |d‚claration de segments|Esc pour sortir|][Confirmer]") Endselect $S% Endif @Vcurs(True) @Showm ' Return Procedure Minitr Local T$ Local A& ' @Showm @W_rdexe T$=@Rinput$("S‚quence … traiter: ($xx=hexa)",T$) @W_rdexe If Len(T$)>0 ' @Wind_clip(4) @Hidem A&=1 Repeat $S& Select Mid$(T$,A&,1) Case "$" Select Mid$(T$,A&+1,1) Case "0" To "9","A" To "F","a" To "f" Select Mid$(T$,A&+2,1) Case "0" To "9","A" To "F","a" To "f" Gosub Emanage(True,Val("$"+Mid$(T$,A&+1,2))) Add A&,2 Default Gosub Emanage(True,Asc(Mid$(T$,A&,1))) Endselect Default Gosub Emanage(True,Asc(Mid$(T$,A&,1))) Endselect ' Default Gosub Emanage(True,Asc(Mid$(T$,A&,1))) ' Endselect $S% ' Inc A& Until A&>Len(T$) @Showm ' Endif ' Return ' ' Souris g dans la fenˆtre mini Procedure Miniset(Mx&,My&) Local Mx2&,My2&,W&,H& Local X&,Y& ' @Hidem Wind_clip(4) ! clipping fenˆtre @Vcurs(False) Mx&=@Wxrcoord(4,Mx&)-Emx& My&=@Wyrcoord(4,My&)-Emy& Mx&=Mx&\Eccsizex& My&=My&\Eccsizey& Mx&=Max(0,Mx&) My&=Max(0,My&) Mx&=Min(Mx&,Vmax_x&) My&=Min(My&,Vmax_y&) X_curs&=Mx& Y_curs&=My& @Vcurs(True) @Showm ~Evnt_timer(50) ' Mx&=@Wxacoord(4,Mx&*Eccsizex&+Emx&) My&=@Wyacoord(4,My&*Eccsizey&+Emy&) Clr Mx2&,My2& If @Xmousek<>0 ' ' ~Graf_rubberbox(Mx&,My&,Eccsizex&,Eccsizey&,Mx2&,My2&) @Hidem Graphmode (3) Mouse Mx2&,My2&,P& Gosub Pbox(Mx&,My&,Mx2&,My2&) Graphmode (1) @Showm ' W&=(@Wxrcoord(4,Mx&)-Emx&)\Eccsizex& H&=(@Wyrcoord(4,My&)-Emy&)\Eccsizey& ' ~@Infow(4,"D‚finiton du segment #"+Str$(Len(Minid$)\8+$ And And And And Imp $" ([SHIFT]: forcer 1 caractŠre)") Repeat Mouse X&,Y&,P& X&=(Min(Vmax_x&-W&+1,Max((X&-Mx&)\Eccsizex&,1)))*Eccsizex&+Mx& Y&=(Min(Vmax_y&-H&+1,Max((Y&-My&)\Eccsizey&,1)))*Eccsizey&+My& ' If X&<>Mx2& Or Y&<>My2& @Lhidem Graphmode (3) Gosub Pbox(Mx&,My&,Mx2&,My2&) Gosub Pbox(Mx&,My&,X&,Y&) Graphmode (1) @Lshowm ' Mx2&=X& My2&=Y& Endif Until P&<>1 @Hidem Graphmode (3) Gosub Pbox(Mx&,My&,Mx2&,My2&) Graphmode (1) @Showm ' Mx2&=(@Wxrcoord(4,Mx2&)-Emx&)\Eccsizex&-W& My2&=(@Wyrcoord(4,My2&)-Emy&)\Eccsizey&-H& Mx&=W& My&=H& ' If (Mx2&>1 Or My2&>1) Or ((Mx2&=>1 Or My2&=>1) And Btst(@É fèáfÉÌ fÌ 1)) ' Ncurs!=False X&=@Wxacoord(4,Emx&) Y&=@Wyacoord(4,Emy&) If Segn! Emul_text(0) Endif @Bndary(0) If Segi! Graphmode (3) Endif Gosub Deffill(1,1,1) @Lhidem Gosub Pbox(X&+Mx&*Eccsizex&+1,Y&+My&*Eccsizey&+1,X&+(Mx&+Mx2&)*Eccsizex&-1,Y&+(My&+My2&)*Eccsizey&-1) Graphmode (1) @Bndary(1) If Segn! Gosub Deftextcol(1) If Mx2&>2 Text X&+Mx&*Eccsizex&,Y&+My&*Eccsizey&+Decalt&(0),Str$(Len(Minid$)\8+1) Else Text X&+Mx&*Eccsizex&,Y&+My&*Eccsizey&+Decalt&(0),Right$(Str$(Len(Minid$)\8+1),Mx2&) Endif Endif @Lshowm ' If Not Set_minid! Set_minid!=True Recept!=False Clr Minid$ @Showm ~@Form_alert(1,"[3][Premier segment d‚fini! |'Return' pour ‚xecuter|'Backspace' pour supprimer|'Esc' pour d‚truire][Confirmer]") Endif If Len(Minid$)<32000 Minid$=Minid$+Mki$(Mx&)+Mki$(My&)+Mki$(Mx2&)+Mki$(My2&) Edited!(10)=True Else @Showm ~@Form_alert(1,"[3][|Trop de segments!!|'Esc' pour les effacer][Annuler]") Endif ' ' ' If @Form_alert(1,"[3][|Transfert vers le bloc #"+Str$(Actb&+1)+" ? |][Confirmer| Annuler ]")=1 ' Gosub Defmouse(2) ' Edited!(Actb&+3)=True ' Binair$(Actb&)=@Miniblock$(Mx&,My&,Mx2&,My2&) ' Gosub Defmouse(0) ' Endif Endif Endif Gosub Drawx(4) @Caremouse ' Return ' ' Menu minidraw Procedure Minimnu Local A&,N& Local A! ' If Not Set_minid! If Btst(Acurs|,4) ! graphique? Ob_state(Adr%(Minidraw&),Md_grf&)=Bset(Ob_state(Adr%(Minidraw&),Md_grf&),0) Ob_state(Adr%(Minidraw&),Md_txt&)=Bclr(Ob_state(Adr%(Minidraw&),Md_txt&),0) Else Ob_state(Adr%(Minidraw&),Md_grf&)=Bclr(Ob_state(Adr%(Minidraw&),Md_grf&),0) Ob_state(Adr%(Minidraw&),Md_txt&)=Bset(Ob_state(Adr%(Minidraw&),Md_txt&),0) Endif ' ' Quelle couleur ? For N&=0 To 7 Ob_state(Adr%(Minidraw&),Md_gr0&+N&)=Bclr(Ob_state(Adr%(Minidraw&),Md_gr0&+N&),0) Ob_state(Adr%(Minidraw&),Md_txt0&+N&)=Bclr(Ob_state(Adr%(Minidraw&),Md_txt0&+N&),0) Next N& ' D‚sinterlacage N&=Intercol&(Min(Max(0,Byte(Div(Ccurs&,&H100))),7)) Ob_state(Adr%(Minidraw&),Md_txt0&+N&)=Bset(Ob_state(Adr%(Minidraw&),Md_txt0&+N&),0) N&=Intercol&(Min(Max(0,Byte(Ccurs&)),7)) Ob_state(Adr%(Minidraw&),Md_gr0&+N&)=Bset(Ob_state(Adr%(Minidraw&),Md_gr0&+N&),0) ' If Btst(Acurs|,0) ! clignotant? Ob_state(Adr%(Minidraw&),Md_cli&)=Bset(Ob_state(Adr%(Minidraw&),Md_cli&),0) Else Ob_state(Adr%(Minidraw&),Md_cli&)=Bclr(Ob_state(Adr%(Minidraw&),Md_cli&),0) Endif ' If Btst(Acurs|,1) ! lignage? Ob_state(Adr%(Minidraw&),Md_lin&)=Bset(Ob_state(Adr%(Minidraw&),Md_lin&),0) Else Ob_state(Adr%(Minidraw&),Md_lin&)=Bclr(Ob_state(Adr%(Minidraw&),Md_lin&),0) Endif ' If Btst(Acurs|,3) ! invers‚? Ob_state(Adr%(Minidraw&),Md_inv&)=Bset(Ob_state(Adr%(Minidraw&),Md_inv&),0) Else Ob_state(Adr%(Minidraw&),Md_inv&)=Bclr(Ob_state(Adr%(Minidraw&),Md_inv&),0) Endif ' If Btst(Acurs|,7) ! DRCS? Ob_state(Adr%(Minidraw&),Md_drcs&)=Bset(Ob_state(Adr%(Minidraw&),Md_drcs&),0) Else Ob_state(Adr%(Minidraw&),Md_drcs&)=Bclr(Ob_state(Adr%(Minidraw&),Md_drcs&),0) Endif ' ' Taille? For N&=0 To 3 Ob_state(Adr%(Minidraw&),Md_tl1&+N&)=Bclr(Ob_state(Adr%(Minidraw&),Md_tl1&+N&),0) Next N& N&=Min(3,Max(0,Tcurs|)) Ob_state(Adr%(Minidraw&),Md_tl1&+N&)=Bset(Ob_state(Adr%(Minidraw&),Md_tl1&+N&),0) ' Exdo!=True A&=Byte(@Form_wdo(Minidraw&,0)) Ob_state(Adr%(Minidraw&),A&)=Bclr(Ob_state(Adr%(Minidraw&),A&),0) ~@Wind_update01(0) ' ~form_dial(3,0,0,0,0,Rx&(Minidraw&),Ry&(Minidraw&),Rw&(Minidraw&),Rh&(Minidraw&)) ~@Form_wdo(Minidraw&,-3) Gosub W_rdexe ' If A&=Md_ok& ' ' Graphique? If Btst(Ob_state(Adr%(Minidraw&),Md_grf&),0) Acurs|=Bset(Acurs|,4) Else Acurs|=Bclr(Acurs|,4) Endif ' ' Clignotant? If Btst(Ob_state(Adr%(Minidraw&),Md_cli&),0) Acurs|=Bset(Acurs|,0) Else Acurs|=Bclr(Acurs|,0) Endif ' Lignage? If Btst(Ob_state(Adr%(Minidraw&),Md_lin&),0) Acurs|=Bset(Acurs|,1) Else Acurs|=Bclr(Acurs|,1) Endif ' Invers‚? If Btst(Ob_state(Adr%(Minidraw&),Md_inv&),0) Acurs|=Bset(Acurs|,3) Else Acurs|=Bclr(Acurs|,3) Endif ' DRCS? If Btst(Ob_state(Adr%(Minidraw&),Md_drcs&),0) Acurs|=Bset(Acurs|,7) If Btst(Acurs|,4) Dmodeg!=True Else Dmodet!=True Endif Else Acurs|=Bclr(Acurs|,7) If Btst(Acurs|,4) Dmodeg!=False Else Dmodet!=False Endif ' Endif ' ' Taille? If Btst(Ob_state(Adr%(Minidraw&),Md_tl1&),0) Tcurs|=0 Else if Btst(Ob_state(Adr%(Minidraw&),Md_tl2&),0) Tcurs|=1 Else if Btst(Ob_state(Adr%(Minidraw&),Md_tl3&),0) Tcurs|=2 Else Tcurs|=3 Endif ' For A&=0 To 7 ' ' Couleur voulue? (texte) If Btst(Ob_state(Adr%(Minidraw&),Md_txt0&+A&),0) ' Interlacage N&=Extercol&(A&) Ccurs&=Or(And(Ccurs&,&HFF),Mul(N&,&H100)) Endif ' ' Couleur voulue? (graphique) If Btst(Ob_state(Adr%(Minidraw&),Md_gr0&+A&),0) N&=Extercol&(A&) Ccurs&=Or(And(Ccurs&,&HFF00),N&) Endif ' Next A& ' Else if A&=Md_seg& Set_minid!=True Recept!=False @Showm ~@Form_alert(1,"[3][|Vous ˆtes en mode de |d‚claration de segments|Esc pour sortir|][Confirmer]") ' Endif ' Else Exdo!=True A&=Byte(@Form_wdo(36,0)) Ob_state(Adr%(36),A&)=Bclr(Ob_state(Adr%(36),A&),0) ~@Form_wdo(36,-3) Gosub W_rdexe $S& Select A& Case Seg_sv& Gosub Save.sgm Case Seg_ld& Gosub Load.sgm Case Seg_ef& Gosub Seg_clr Case Seg_ex& Gosub Seg_exe Endselect $S% ' A!=False If Btst(Ob_state(Adr%(36),Seg_no&),0) If Not Segn! Segn!=True A!=True Endif Else If Segn! Segn!=False A!=True Endif Endif If Btst(Ob_state(Adr%(36),Seg_in&),0) If Not Segi! Segi!=True A!=True Endif Else If Segi! Segi!=False A!=True Endif Endif If A! Rdw_all(4) Endif ' Endif Gosub Drawx(4) ! barre infos ' Return ' Procedure Minichar(Key&) Local Flag!,C|,D|,C& ' @Hidem Wind_clip(4) ! clipping fenˆtre C|=Acurs| D|=Tcurs| C&=Ccurs& Flag!=True ' Dessiner caractŠre! @Vcurs(False) ' If Not Btst(Acurs|,4) ! TEXTE If Key&<>32 ' Non au d‚but? If X_curs&>0 ' Dernier caractŠre <> du pr‚sent! If Vidc&(X_curs&-1,Y_curs&)<>Or(And(Vidc&(X_curs&-1,Y_curs&),&HFF00),Byte(Ccurs&)) ' Dernier char<>space? If Byte(Vids&(X_curs&-1,Y_curs&))<>32 ' Car 1 caractŠre espace pour d‚clarer fond!! Ccurs&=Or(And(Ccurs&,&HFF00),Byte(Vidc&(X_curs&-1,Y_curs&))) Else ! declare character Vidc&(X_curs&-1,Y_curs&)=Or(And(Vidc&(X_curs&-1,Y_curs&),&HFF00),Byte(Ccurs&)) Endif Gosub Vdraw(X_curs&-1,Y_curs&) Endif Else ! 1er char, pas de fond! Ccurs&=And(Ccurs&,&HFF00) ' Next char <>32? alors fond noir aussi! ' ' To Do! ' If Byte(Vids&(X_curs&+1,Y_curs&))<>32 ' Gosub Vdraw(X_curs&+1,Y_curs&) ' Endif ' Endif Endif Endif ' Echar(X_curs&,Y_curs&,Key&,Flag!) @Vcurs(True) Acurs|=C| Tcurs|=D| Ccurs&=C& @Showm ' Return ' ' Manager de redraws en bloc - Tous les atrrb sont cens‚s ˆtre annul‚s Function Miniblock$(X&,Y&,W&,H&) Local N& Local A|,C&,T| Local T$,E$ ' ' Bloc Clr E$ ! Bloc r‚sultant ' ' Bouclage Clr A|,T| ! attributs/texte nuls aprŠs un POS C&=&H700 ! ainsi que la couleur For N&=Y& To Y&+H&-1 ' ' 1ø positionner curseur If X&=0 And N&=1 ! pos E$=E$+Home$ Clr A|,T| ! attributs/texte nuls aprŠs un HOME C&=&H700 ! ainsi que la couleur Else if X&=0 And N&<>Y& ! mais pas 1er pos (pas de cr en 1er!) ' If X&+W&A| ! Diff‚rence ' ' Or: 0 et 0 ; 1 et 1 -> ok (ne rien changer) ' ' ..Graphique If Not (Btst(A|,4)=Btst(Vida|(N&,Y&),4)) If Btst(Vida|(N&,Y&),4) C$=Graph$ ' E$=E$+Graph$ Else C$=Text$ ' E$=E$+Text$ Endif Endif Rem ' ' ..Lignage If Not (Btst(A|,1)=Btst(Vida|(N&,Y&),1)) If Btst(Vida|(N&,Y&),1) ' mode TEXTE et LINE aprŠs espace? si nxt char espace bah non, car espace pas soulign‚ (le 1er en tt cas) ' If (Right$(E$,1)=" ") And (Not Btst(A|,4)) And (Byte(Vids&(N&,Y&))<>32) If (Right$(E$,1)=" ") And (Not Btst(A|,4)) ' bin non Line c'est avant espace patate! E$=Left$(E$,Len(E$)-1)+C$+Line$+" " ! et voilu Else E$=E$+C$+Line$ Endif Else If (Right$(E$,1)=" ") And (Not Btst(A|,4)) ! idem E$=Left$(E$,Len(E$)-1)+C$+Lineoff$+" " ! et voilu Else E$=E$+C$+Lineoff$ Endif Endif Clr C$ ! texte/graph AVANT in line ! (ouf!!) Endif ' ' Ajouter? (texte/graph) If Len(C$)>0 E$=E$+C$ ! ajouter Clr C$ Endif ' ' ..Clignotement If Not (Btst(A|,0)=Btst(Vida|(N&,Y&),0)) If Btst(Vida|(N&,Y&),0) E$=E$+Flash$ Else E$=E$+Flashoff$ Endif Endif ' ..Masquage If Not (Btst(A|,2)=Btst(Vida|(N&,Y&),2)) If Btst(Vida|(N&,Y&),2) E$=E$+Mask$ Else E$=E$+Maskend$ Endif Endif ' ..Invers‚ If Not (Btst(A|,3)=Btst(Vida|(N&,Y&),3)) If Btst(Vida|(N&,Y&),3) E$=E$+Inverse$ Else E$=E$+Inverseoff$ Endif Endif ' ..DRCS If Not (Btst(A|,7)=Btst(Vida|(N&,Y&),7)) If Not Btst(Vida|(N&,Y&),4) ! Texte If Btst(Vida|(N&,Y&),7) E$=E$+Drcton$ Else E$=E$+Drctoff$ Endif ' Else ! Graph If Btst(Vida|(N&,Y&),7) E$=E$+Drcgon$ Else E$=E$+Drcgoff$ Endif Endif Endif ' A|=And(Vida|(N&,Y&),&X10011111) ' Endif ! Attribut(s) a (ont) chang‚(s) ? ' If T|<>Byte(And(Div(Vids&(N&,Y&),&H100),&X11)) ! Diff‚rence ' T|=Byte(And(Div(Vids&(N&,Y&),&H100),&X11)) ! Diff‚rence ' ' Print Byte(And(Div(Vids&(N&,Y&),&H100),&X11)) ! Id $S& Select T| ! Id Case 0 E$=E$+Tn$ Case 1 E$=E$+Dh$ Case 2 E$=E$+Dl$ Case 3 E$=E$+Dt$ Endselect $S% ' Endif ' If C&<>Vidc&(N&,Y&) ! Diff‚rence de couleur ' ' Changer col texte If And(C&,&HFF00)<>And(Vidc&(N&,Y&),&HFF00) A&=Min(7,Max(0,Byte(Div(And(Vidc&(N&,Y&),&HFF00),&H100)))) A&=Intercol&(A&) E$=E$+Esc$+Ec$(0,A&) Endif ' ' Changer col fond If Byte(C&)<>Byte(Vidc&(N&,Y&)) A&=Min(7,Max(0,Byte(Vidc&(N&,Y&)))) A&=Intercol&(A&) E$=E$+Esc$+Ec$(1,A&) Endif ' C&=Vidc&(N&,Y&) ' Endif ' ' Ajouter caractŠre! E$=E$+Chr$(Byte(Vids&(N&,Y&))) ' If Btst(T|,1) Inc N& ! bah oui, double! Endif If Btst(T|,0) If N&=>Vmax_x& ! a d‚pass‚ a ligne - donc va sauter DEUX lignes (dble!!!!) - on en retire alors une! If L&=Vmax_x&+1 E$=E$+C_h$ ! hop! Endif Endif Endif ' Else ! CaractŠre haut ou droite.. passer! E$=E$+C_d$ ! curseur droit.. ' Endif ! Test de chevauchment de HIGH char ' ' Next N& Inc N& Loop until N&>X&+L&-1 ' Return E$ ! renvoyer Endfunc ' Procedure Seg_exe Local A&,X&,Y&,W&,H& ' If Len(Minid$)>0 Gosub Defmouse(2) Edited!(Actb&+3)=True Binair$(Actb&)="" For A&=1 To Len(Minid$) Step 8 ~@Infow(4,"Traitement du segment: "+Str$((A&-1)\8+$ And And And And Imp $"/"+Str$(Len(Minid$)\8)+" ("+Str$(Round(100*((A&-1)/(Len(Minid$)-1)),1))+"%)") X&=Cvi(Mid$(Minid$,A&,2)) Y&=Cvi(Mid$(Minid$,A&+2,2)) W&=Cvi(Mid$(Minid$,A&+4,2)) H&=Cvi(Mid$(Minid$,A&+6,2)) Binair$(Actb&)=Binair$(Actb&)+@Miniblock$(X&,Y&,W&,H&) Exit if Len(Binair$(Actb&))>30000 Next A& ~@Infow(4,"Traitement du segment: "+Str$(Len(Minid$)\8)+"/"+Str$(Len(Minid$)\8)+" (100%)") Gosub Defmouse(0) @Showm Gosub Comm.info("M","Bloc VDT "+Str$(Actb&+1)+", longueur: "+Str$(Len(Binair$(Actb&)))+" octets.") ~@Form_alert(1,"[3][|Page encod‚e dans le bloc #"+Str$(Actb&+1)+"|Effacer segments: 'Esc'|][Confirmer]") Else @Showm ~@Form_alert(1,"[3][|Pas de segments!][Annuler]") Endif ' Clr Minid$ ' Set_minid!=False Gosub Drawx(4) ' Rdw_all(4) Return Procedure Seg_del Local X&,Y&,W&,H& ' If Len(Minid$)>0 Edited!(10)=True Wind_clip(4) X%=@Wxacoord(4,Emx&) Y%=@Wyacoord(4,Emy&) @Emul_text(0) Gosub Deftext(1,0) Gosub Deffill(1,1,1) @Bndary(0) X&=Cvi(Mid$(Minid$,Len(Minid$)-7,2)) Y&=Cvi(Mid$(Minid$,Len(Minid$)-5,2)) W&=Cvi(Mid$(Minid$,Len(Minid$)-3,2)) H&=Cvi(Mid$(Minid$,Len(Minid$)-1,2)) If Segi! Graphmode (3) Gosub Pbox(X%+X&*Eccsizex&+1,Y%+Y&*Eccsizey&+1,X%+(X&+W&)*Eccsizex&-1,Y%+(Y&+H&)*Eccsizey&-1) Graphmode (1) If Segn! @Bndary(1) Endif ~Form_dial(3,0,0,0,0,X%+X&*Eccsizex&,Y%+Y&*Eccsizey&,3*Eccsizex&,Eccsizey&) Else ~Form_dial(3,0,0,0,0,X%+X&*Eccsizex&,Y%+Y&*Eccsizey&,W&*Eccsizex&,H&*Eccsizey&) Endif ' Text X%+X&*Eccsizex&,Y%+Y&*Eccsizey&+Decalt&(0)," " ' Minid$=Left$(Minid$,Len(Minid$)-8) Else @Showm ~@Form_alert(1,"[3][|Pas de segments!][Annuler]") Endif Gosub Drawx(4) Return Procedure Seg_clr If Len(Minid$)>0 @Showm If @Form_alert(1,"[3][|Effacer segments?|][Confirmer| Annuler ]")=1 Edited!(10)=False Clr Minid$ Ncurs!=True Set_minid!=False If Wopen!(4) Rdw_all(4) Endif Endif Else Set_minid!=False Endif Gosub Drawx(4) Return ' Procedure Load.sgm Local File$ ' @Showm File$=@Fsel$("\*.SGM",File$(8),"Charger segments") If Len(File$)>0 If @Fexist(File$) File$(8)=File$ Open "I",#1,File$(8) If Input$(8,#1)="SWSegM10" Edited!(10)=False Emul!=False Recept!=False Minid$=Input$(Lof(#1)-8,#1) Gosub Comm.info("Charger *.SGM","Segments charg‚s") Else Gosub Comm.info("Charger *.SGM","erreur de format") ~@Form_alert(1,"[3][|Mauvais format|][Annuler]") Endif Close #1 If Wopen!(4) Rdw_all(4) Endif Else Gosub Comm.info("Charger *.SGM","Fichier introuvable!") Endif Else Gosub Comm.info("Charger *.SGM","annul‚") Endif Gosub Drawx(4) Return Procedure Save.sgm Local File$ ' Gosub Drawx(4) If Len(Minid$)>0 @Showm File$=@Fsel$("\*.SGM",File$(8),"Sauver segments") If Len(File$)>0 File$(8)=File$ Open "O",#1,File$(8) Print #1,"SWSegM10"; Print #1,Minid$; Close #1 Edited!(10)=False ' Gosub Comm.info("Sauver *.SGM","Segments sauv‚s") Endif Else Gosub Comm.info("Sauver *.SGM","annul‚") Endif Return Procedure Save.pag Local File$ ' Gosub Drawx(4) @Showm File$=@Fsel$("\*.VDT",File$(2),"Sauver page vid‚otex") If Len(File$)>0 Gosub Defmouse(2) Binair$(6)=@Miniblock$(0,0,40,25) ! page entiŠre! Gosub Defmouse(0) ' File$(2)=File$ Open "O",#1,File$(2) Print #1,Binair$(6); Close #1 ' Gosub Comm.info("Sauver page *.VDT","Page sauv‚e") Else Gosub Comm.info("Sauver page *.VDT","annul‚") Endif Return Procedure Save.imgpag Local File$ Local X2&,Y2&,X2%,Y2% Local W&,H& Local L%,M%,M2% Local X&,Y& Local N&,A&,B&,C& Local A%,R%,B% Local Adr% Local Mf1%,Mf2%,Mf3%,Mpal% Local N& Local E%,H% Local Ext$ Local Trset& ' If Wim%>0 X2%=Start_x%(4) Y2%=Start_y%(4) @Top(4) If Wopen!(4) Gosub Drawx(4) @Showm W&=Div(W_iw&(4),Eccsizex&) H&=Div(W_ih&(4),Eccsizey&) ' N&=(Vmax_x&+1)*Eccsizex& ! vdt linewidth If Mod(N&,16)<>0 N&=(N&\16+1)*16 Endif L%=(N&*(Vmax_y&+1)*Eccsizey&) Mul L%,Plans& ! *Nb de plans=Nb de bits Div L%,8 ! \8=nb d'octets ' If W&=>1 And H&=>1 M%=@Malloc(L%) ! r‚server! ' If M%>0 ' *~C:Clrblk%(L:M%,L:L%) ! effacer Gosub Defmouse(2) X2%=Start_x%(4) Y2%=Start_y%(4) @Wind_clip(4) Gosub Deffillcol(0) @Lhidem Pbox W_ix&(4),W_iy&(4),W_ix&(4)+W_iw&(4)-1,W_iy&(4)+W_ih&(4)-1 @Lshowm Gosub Deffillcol(1) ' X2&=W_ix&(4) Y2&=W_iy&(4) For Y&=0 To Vmax_y& Start_y%(4)=Emy&+Y&*Eccsizey& ~@Infow(4,"Construction de la page (#"+Str$(Y&)+"/24)") For X&=0 To Vmax_x& Start_x%(4)=Emx&+X&*Eccsizex& Vdraw(X&,Y&) ' G_s%(0)=M% ! placer adresse G_s%(1)=(Vmax_x&+1)*Eccsizex& G_s%(2)=(Vmax_y&+1)*Eccsizey& G_s%(3)=N&\16 ! d‚ja div par 16 G_s%(4)=0 G_s%(5)=Plans& ' R_d%(0)=X2& R_d%(1)=Y2& R_d%(2)=X2&+Eccsizex&-1 R_d%(3)=Y2&+Eccsizey&-1 R_d%(4)=X&*Eccsizex& R_d%(5)=Y&*Eccsizey& R_d%(6)=X&*Eccsizex&+Eccsizex&-1 R_d%(7)=Y&*Eccsizey&+Eccsizey&-1 R_d%(8)=3 ' Bitblt G_screen%(),G_s%(),R_d%() ! Vdi Raster Copy ; Opaque ' Next X& Next Y& ' Rd_all(4,W_ix&(4),W_iy&(4),W&*Eccsizex&,H&*Eccsizey&) ' Start_x%(4)=X2% Start_y%(4)=Y2% Rdw_all(4) Gosub Defmouse(0) ' B&=@Rim_sel(True,Wim%,"WIMs","Format de sauvegarde",0) ! -2 si erreur ' If B&=>0 A%=Wim%+4 If B&>0 For A&=0 To B&-1 Add A%,Long{A%}+4 Next A& Endif ' ' ‚crire-> ' If Long{A%+4}=Cvl("WRIT") If Long{A%+4+4}=Cvl("_IMG") Select Long{A%+8+4} Case "_VDI","_SHI","_VSH" Mf1%=@Malloc(1536+60) Mf2%=Mf1%+20 Mf3%=Mf1%+40 Mpal%=Mf1%+60 ' Select Plans& Case 1 N&=2 Case 2 N&=4 Case 4 N&=16 Case 8 N&=256 Default Clr N& Endselect If N&>0 Pal%=@Malloc(N&*6) ! R,V,B sur 2 octets = 6 octets par couleur For A&=0 To N&-1 Contrl(0)=26 ! inquire color rep. Contrl(1)=0 Contrl(3)=2 Contrl(6)=V~h Intin(0)=A& Intin(1)=0 ! d‚finies Vdisys ' noter composantes palette: Word{Pal%+A&*6}=Intout(1) Word{Pal%+A&*6+$ And And And And Eqv And }=Intout(2) Word{Pal%+A&*6+4}=Intout(3) Next A& Else Pal%=1 Endif ' If Mf1%>0 And Pal%>0 If Pal%=1 Clr Pal% ! pas de palette! Endif Mf2%=Mf1%+20 ' @Comp.info("E","Traitement export: "+Char{A%+24+4}) For A&=0 To 19 Byte{Mf1%+A&}=0 Byte{Mf2%+A&}=0 Next A& Long{Mf1%}=M% W&=(Vmax_x&+1)*Eccsizex& H&=(Vmax_y&+1)*Eccsizey& Word{Mf1%+4}=W& Word{Mf1%+6}=H& If Mod(Word{Mf1%+4},16)=0 Word{Mf1%+8}=Word{Mf1%+4}\16 Else Word{Mf1%+8}=Word{Mf1%+4}\16+1 Endif Word{Mf1%+10}=0 ! ‚cran pour le moment Word{Mf1%+12}=Plans& ! oui, en couleurs peut ˆtre! ' If M%>0 ' ' ** 1er appel ** R%=A%+56+4 ~C:R%(L:Mf1%) Ext$=Mkl$(Long{Mf1%}) ' Select Ext$ Case "_WIM" File$="*" Default File$=@Fsel$("\*"+Ext$,File$(5),"Sauver page graphique") If Len(File$)<=0 Gosub Comm.info("Sauver page graphique","annul‚") Endif Endselect ' H%=0 ! handle If Len(File$)>0 If File$="*" Clr File$ Endif ' ' ***If Word{Mf1%+12}=Plans& ! on verra aprŠs!! Trset&=Word{Mf1%+12} ! noter, Word{Mf1%+12}=Plans& ! et toc! ' If Word{Mf1%+4}<>W& Or Word{Mf1%+6}<>H& ' @Comp.info("E","Changement de taille: "+Str$(Word{Mf1%+4})+"*"+Str$(Word{Mf1%+6})) M2%=@Malloc(Word{Mf1%+6}*Word{Mf1%+8}*2*Word{Mf1%+12}) If M2%>0 ' *~C:Clrblk%(L:M2%,L:Word{Mf1%+6}*Word{Mf1%+8}*2*Word{Mf1%+12}) ! effacer ' Word{Mf1%+10}=0 For A&=0 To 19 Byte{Mf2%+A&}=Byte{Mf1%+A&} Next A& Long{Mf1%}=M2% ' Long{Mf2%}=M% Word{Mf2%+4}=W& Word{Mf2%+6}=H& If Mod(W&,16)=0 Word{Mf2%+8}=W&\16 Else Word{Mf2%+8}=W&\16+1 Endif ' Contrl(0)=109 ! vro_cpyfm Contrl(1)=4 Contrl(3)=1 Contrl(6)=V~h Contrl(7)=Word(Swap(Mf2%)) Contrl(8)=Word(Mf2%) Contrl(9)=Word(Swap(Mf1%)) Contrl(10)=Word(Mf1%) Intin(0)=3 Ptsin(0)=0 Ptsin(1)=0 Ptsin(2)=Min(W&-1,Word{Mf1%+4}-1) Ptsin(3)=Min(H&-1,Word{Mf1%+6}-1) Ptsin(4)=0 Ptsin(5)=0 Ptsin(6)=Ptsin(2) Ptsin(7)=Ptsin(3) Vdisys ! transfert ' Swap M%,M2% ~@Mfree(M2%) Else ~@Mfree(M%) ~@Form_alert(1,"[3][|Plus de m‚moire disponible!|(transfert)][ Annuler ]") Endif Endif ' ' Image a la bonne taille, palette prˆte If M%>0 ! on continue ' ' Mauvais format ‚cran? ' transform form: Select Long{A%+8+4} Case "_VDI","_VSH" ! transfert @Comp.info("E","Transfert vers format standard") M2%=@Malloc(L%) ! r‚server second! ' If M2%>0 ' *~C:Clrblk%(L:M2%,L:L%) ! effacer ' copier Word{Mf1%+10}=1 For A&=0 To 19 Byte{Mf2%+A&}=Byte{Mf1%+A&} Next A& ' Word{Mf2%+10}=0 ! format non standard Long{Mf2%}=M% ! d‚part Word{Mf1%+10}=1 ! standard vdi!! Long{Mf1%}=M2% ! dest ' Contrl(0)=110 Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Contrl(7)=Word(Swap(Mf2%)) Contrl(8)=Word(Mf2%) Contrl(9)=Word(Swap(Mf1%)) Contrl(10)=Word(Mf1%) Vdisys ! transform form! ' Swap M%,M2% ~@Mfree(M2%) ' Else ~@Mfree(M%) ~@Form_alert(1,"[3][|Plus de m‚moire disponible!|(tampon)][ Annuler ]") Endif ' Endselect ' ' Palette ok,Taille ok, format ecran ok, tramer? If Plans&<>Trset& ! shit, tramer! ' ~@Wind_update01(0) Exdo!=True Gosub Defmouse(0) C&=@Rim_sel(False,Trm%,"TRMs","Type de tramage",0) ! -2 si erreur Gosub Defmouse(2) ~@Wind_update01(1) If C&=>0 @Menu.info("Tramage en cours") ' For A&=0 To 19 Byte{Mf2%+A&}=Byte{Mf1%+A&} Next A& Word{Mf2%+10}=Word{Mf1%+10} ! SHI Word{Mf2%+12}=Trset& ! nb col F&=Word{Mf1%+10} ! sauver format (0,1) ' ' *** Test Trame file *** R%=Trm%+&H7A6+2 E%=C:R%(W:0,W:C&+1,L:0,L:Mf1%,L:Pal%,L:Mf2%,L:Mpal%,W:&X11) If E%=>0 If E%>0 If E%=-1 ! Malloc all!! E%=@Malloc(-1) Sub E%,Word{Mf1%+6}*Word{Mf1%+8}*2*Word{Mf1%+12}*3 E%=Max(33000,E%) Endif B%=@Malloc(E%) ' If B%>0 ' *~C:Clrblk%(L:B%,L:E%) ! effacer ' Endif Else B%=1 Endif If B%>0 If B%=1 Clr B% Endif ' If Word{Mf1%+10}<>F& ! format diff‚rent? If Form_alert(1,"[3][|Mauvais format interne, |continuer?|][Confirmer|Annuler]")=2 ~@Mfree(M%) Endif Endif ' If M%>0 ' Bit_uninit ' Bit_set(Word{Mf2%+4},Word{Mf2%+6}) M2%=@Malloc(Word{Mf2%+6}*Word{Mf2%+8}*2*Word{Mf2%+12}) If M2%>0 Long{Mf2%}=M2% R%=Trm%+&H7A6+$ And And And And Eqv And ' ~Inp(2) ' *** Trame file *** E%=C:R%(W:1,W:C&+1,L:B%,L:Mf1%,L:Pal%,L:Mf2%,L:Mpal%,W:&X11) If E%<0 ~@Form_alert(1,"[1][|Tramage impossible!|#2b|][ Annuler ]") Else For A&=0 To 19 Byte{Mf1%+A&}=Byte{Mf2%+A&} Next A& Swap M%,M2% Endif Else ~@Mfree(M%) ~Form_alert(1,"[3][|Plus de m‚moire disponible!|(trns2b)][ Annuler ]") @Comp.info("B","plus de m‚moire disponible pour tramage ("+Str$(Malloc(-1))+")") Endif Endif Else ~@Mfree(M%) ~Form_alert(1,"[3][|Plus de m‚moire disponible!|("+Str$(E%)+")][ Annuler ]") @Comp.info("B","plus de m‚moire disponible ("+Str$(Malloc(-1))+")") Endif Else ~@Mfree(M%) ~@Form_alert(1,"[1][|Tramage impossible!|#1|][ Annuler ]") @Comp.info("B","tramage impossible") Endif Else ~@Mfree(M%) ~@Form_alert(1,"[1][|Tramage annul‚|][ Annuler ]") @Comp.info("B",".. tramage annul‚") Endif ' If M2%>0 ~@Mfree(M2%) Endif If B%>0 ~@Mfree(B%) Endif Endif ! si tramer? ' If M%>0 ! on continue? Select Ext$ Case "_WIM" Default ' File$=File$+Chr$(0) H%=Gemdos(60,L:V:File$,W:0) ' @Comp.info("E","G‚n‚ration de l'image") ' ** 2e appel ** Long{Mf1%}=M% ! dest Word{Mf1%+18}=H% ! handle fichier Word{Mf1%+14}=H% ! handle fichier!!! R%=A%+60+4 E%=C:R%(L:Mf1%,L:Pal%) If E%=>0 If E%>0 B%=@Malloc(E%) Else B%=1 Endif If A%<=0 ~@Form_alert(1,"[3][|Plus de m‚moire disponible!|(traitement)][ Annuler ]") Clr B% Endif Else ~@Form_alert(1,F4fls% f$fÌ Ì fÌnote: eccsizey)Double{\:= With With Mkf$(Min( With )' Downto #):Double{\)Asin(Cfloat(Cfloat(Min( As Mkf$( With )Double{) B%=-1 Endif If B%>0 If B%=1 Clr B% Else ' *~C:Clrblk%(L:B%,L:E%) ! effacer Endif ' file$=file$+Chr$(0) ' h%=gemdos(60,L:V:File$,W:0) ' print At(1,1);H%, If H%=>0 Long{Mf1%}=M% ! dest Word{Mf1%+18}=H% ! (handle fichier) Word{Mf1%+14}=H% ! handle fichier!!! ' R%=A%+64+4 E%=C:R%(L:Mf1%,L:Pal%,L:B%) If E%<0 ~@Form_alert(1,"[3][|Erreur WIM |][ Annuler ]") Else If E%>0 E%=Gemdos(64,H%,L:E%,L:B%) If E%<0 @Comp.info("E","Erreur fichier "+Str$(E%)) ~@Form_alert(1,"[3][|Erreur fichier "+Str$(E%)+" |][ Annuler ]") Endif Endif Endif ' E%=Gemdos(62,H%) If E%<0 @Comp.info("E","Erreur fichier "+Str$(E%)) ~@Form_alert(1,"[3][|Erreur fichier "+Str$(E%)+" |][ Annuler ]") Endif H%=-1 Gosub Comm.info("Sauver page graphique","Page sauv‚e") Else @Comp.info("E","Erreur fichier "+Str$(H%)) ~@Form_alert(1,"[3][|Erreur fichier "+Str$(H%)+" |][ Annuler ]") Endif If B%>0 ~@Mfree(B%) Endif Endif Endselect ! g‚n‚rant? Endif ! tramage error ' Else ~@Form_alert(1,"[3][|Plus de m‚moire disponible!|][ Annuler ]") Endif Else ~@Form_alert(1,"[3][|Nombre de couleurs |diff‚rent!|][ Annuler ]") Endif ' ~@Mfree(Mf1%) ' Else ~@Form_alert(1,"[3][|Nombre de plans incompatible |][ Annuler ]") Endif ' Else ! erreur malloc ~@Form_alert(1,"[3][|Plus de m‚moire disponible!|][ Annuler ]") Endif Default ~@Form_alert(1,"[3][|Type WIM inconnu |][ Annuler ]") Endselect ! VDI,SHI Else ~@Form_alert(1,"[3][|Type WIM inconnu |][ Annuler ]") Endif ! WRIT Else ~@Form_alert(1,"[3][|Type WIM inconnu |][ Annuler ]") Endif ! READ ' Endif ' Endif ' Endif Endif ' ~@Mfree(M%) ! d‚sallouer! If H%<>-1 E%=Gemdos(62,H%) H%=-1 Endif ' Else ~Form_alert(1,"[3][|Pas de WIMs PARX charg‚s!|][ Annuler ]") Endif ~@Wind_update01(0) Gosub Defmouse(0) @Comp.info("","") Return ' ' ' ' /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ ' Fin de l'‚mulateur, ½Xavier ROCHE 1993 ' /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ ' ' ' Sous routines diverses Procedure Part_draw(N&) Local A&,Rx&,Ry&,Rw&,Rh&,T$,X2&,X&,Y&,W&,H& ' $S& Select N& Case 0,1 Index&=4 Endselect $S% ' ' Fenˆtre ouverte? If Wopen!(Index&) @Lhidem A&=@Wind_update01(-1) If A&=0 ' ..Verouillage du GEM A&=@Wind_update01(1) Endif Clr T$ Clr X2& ~Wind_get(Whandle&(Index&),11,Rx&,Ry&,Rw&,Rh&) $S& Select N& Case 0,1 X&=@Wxacoord(4,Eccsizex&*X_curs&+Emx&) Y&=@Wyacoord(4,Eccsizey&*Y_curs&+Emy&) W&=Eccsizex& H&=Eccsizey& Endselect $S% While Rw&>0 ' If Rc_intersect(X&,Y&,W&,H&,Rx&,Ry&,Rw&,Rh&) @Clip(Rx&,Ry&,Rw&,Rh&) $S& Select N& Case 0 @Vcurs(False) Case 1 @Vcurs(True) Endselect $S% Endif ~Wind_get(Whandle&(Index&),12,Rx&,Ry&,Rw&,Rh&) ' Wend If A&=0 ! Restaurer situation ' ..D‚v‚rouillage du GEM ~@Wind_update01(0) Endif @Lshowm Endif ' Return ' ' ' ' ' ' ' ' ' ' Procedure Test_rout Local A% ' A%=0 A%=A%+(Dpeek(R40cl%)=0) A%=A%+(Dpeek(R40st%)=0) A%=A%+(Dpeek(Rlsl%)=0) A%=A%+(Dpeek(Rlsr%)=0) A%=A%+(Dpeek(Rinv%)=0) A%=A%+(Dpeek(Rbn%)=0) A%=A%+(Dpeek(Tst63%)=0) A%=A%+(Dpeek(Wherest%)=0) A%=A%+(Dpeek(Drawline%)=0) A%=A%+(Dpeek(Vflip%)=0) A%=A%+(Dpeek(Hflip%)=0) A%=A%+(Dpeek(Ssright%)=0) A%=A%+(Dpeek(Ssdown%)=0) A%=A%+(Dpeek(Cache%)=0) A%=A%+(Dpeek(Teststr%)=0) A%=A%+(Dpeek(Indent%)=0) A%=A%+(Dpeek(Blitc%)=0) A%=A%+(Dpeek(Swmin%)=0) A%=A%+(Dpeek(Swchar%)=0) If A%<>0 @Printl(Chr$(27)+"EErreur routine g‚n‚rale 0") ~Gemdos(1) @Printl("Leaving sweetel..") On error gosub Eop Edit Endif Return ' Procedure Eop ! avant edit (handle incorrect) Gosub Defmouse(2) Edit Return ' ' $P< ' Procedure Werror ! bug intercept - ne pas oublier $P< !! ' Local A% ' Gosub Xwerror ! eh oui ca suffit (bin non!!) ' Return ' $P> ' Procedure Ywerror ' Local A% ' Gosub Xwerror ' Return ' ' A partir d'ici, on peut appeller des proc‚dures Procedure Werror Local Err_a&,Dummy& ' On error gosub Werror Erreur!=True ! bah oui ' ' Void fre(0) ! a bannir!! @Showm ~@Wind_update01(0) Gosub Defmouse(0) ' If Err=8 Clr Vid$ Binair$(Actb&)="" Endif ' If Vopen! And (Not Erreur!) ' Send(Beep$+Cls$+Chr$(31)+"@A"+@Errf$(Err)+Beep$) ' Endif ' Defmouse 0 ' If Err=-37 Defmouse 2 Edit Endif ' If Help! ~@Form_alert(1,"[1][Une erreur logicielle est |survenue ... |Sauvegardez votre source |pour ne pas le perdre!][ Stopper ]") Endif ~@Form_alert(1,@Errf$(Err)) ' Close #1 Close #2 If @Form_alert(1,"[2][|"+"D‚sirez- vous sauver votre |source avant de quitter? |][Confirmer| Quitter ]")=1 ' @Save.swt ~@Env_save ~@Wind_update01(0) Endif ' If Dim?(Wopen!()) Defmouse 2 ' ..Fermer tout ce qui reste Wmove(0,0,W_desk&,H_desk&,W_desk&\2,H_desk&\2,1,1) For Err_a&=0 To Nbr_idxw& ' hideclose=close sans graf_XXXX ~@Wind_hideclose(Err_a&) ! 9ø Gosub W_rdexe Next Err_a& ~Evnt_timer(100) ' Gosub Winds_uninit ' Endif If Menu_adr%>0 @Menu_close ! menu off Endif Gosub Uninistr Gosub Uninit ' - Gosub Winds_uninit ! xxx Erase Blt$() Defmouse 0 ' ' If Not accessoire! If Not (Err=>0 And Err<=6) If @Form_alert(1,"[1][Note: system error # "+Str$(Err)+" |ERflag: "+Chr$(-Fatal+48)+" |VDIflag: "+Str$(V~h)+" |APflag: "+Str$(Ap&)+" / MULflag: "+Str$(Multi!)+" ][ Hell! | Repartir ]")=2 Close #1 Close #2 Resume Startex Endif On error gosub Eop Edit ' Else ~@Form_alert(1,"[1][Note: system error # "+Str$(Err)+" |ERflag: "+Chr$(-Fatal+48)+" |VDIflag: "+Str$(V~h)+" |APflag: "+Str$(Ap&)+" / MULflag: "+Str$(Multi!)+" ][ Hell! ]") On error gosub Eop Edit Endif ' Else ' ' Defmouse 2 ' Erase Page$(),Pag_adr%(),Pag_len&(),Pag_ind&() ' Erase Wmenu&() ' Void Fre(0) ' Dim Wmenu&(7) ! Tampon message ' Defmouse 0 ' @Showm ' ~@Form_alert(1,"[1][Note: system error # "+Str$(Err)+" |ERflag: "+Chr$(-Fatal+48)+" |VDIflag: "+Str$(V~h)+" |APflag: "+Str$(Ap&)+" / MULflag: "+Str$(Multi!)+" ][ Hell! ]") ' Do ' ~Evnt_mesag(Varptr(Wmenu&(0))) ' If Wmenu&(0)=40 ' If Help! ' Err_a&=-2 ! ac_hidden ' Gosub Help(0,Err_a&) ' Endif ' If @Form_alert(1,"[1][|"+"Par suite d'"+"erreur"+" |Accessoire d‚sactiv‚ |][ Annuler | Kill ]")=2 ' If @Form_alert(1,"[3][|"+"Destruction de processus? |(MiNT)][ Annuler | KILL! ]")=2 ' On error gosub Eop ' Edit ' Endif ' Endif ' Endif ' Loop ' ' Endif ' Return ' ' ' ' Procedure Wherexy(Var X&,Y&) Local A& ' @Waitout1 If Online! ' X&=1 Y&=1 @Videmntl Print #5,Whatxy$; Clr A& While (A&<10) And (Not Bios(1,1)) Inc A& ~Evnt_timer(10) Wend If Bios(1,1) If Bios(2,1)=31 Y&=Bios(2,1)-64 X&=Bios(2,1)-64 ' Endif ! 31 Endif ! inp?1 ' Endif ! if online ' Return Procedure Closetel ' If Vopen! If Set_speed! If Speed&<>0 Gosub Defmouse(2) @1200b Gosub Defmouse(2) Endif Send(Cls$+Curson$) Gosub Defmouse(2) Else Atsend(Modem$(1)) ! end Endif Endif ' Return Procedure Resetv Outvid(Reset$) Return Procedure 300b If Set_speed! @Videmntl Outvid(V300b$) Delay 0.6 ~Xbios(15,9,0,174,-1,-1,-1) Endif @Videmntl Return Procedure 1200b If Set_speed! @Videmntl Outvid(V1200b$) Delay 0.6 ~Xbios(15,7,0,174,-1,-1,-1) Endif @Videmntl Return Procedure 4800b If Set_speed! @Videmntl Outvid(V4800b$) Delay 0.6 ~Xbios(15,2,0,174,-1,-1,-1) Endif @Videmntl Return Procedure 9600b If Set_speed! @Videmntl Outvid(V9600b$) Delay 0.6 ~Xbios(15,1,0,174,-1,-1,-1) Endif @Videmntl Return Procedure Setspeed Gosub Defmouse(2) $S& Select Speed& Case 0 @1200b Case 3 @300b Case 1 @4800b Case 2 @9600b Case 4 Delay 0.2 ~Xbios(15,-1,0,174,-1,-1,-1) Delay 0.6 Endselect $S% Gosub Defmouse(0) Return Function S_speed $F% If Set_speed! ! prise en compte de la vitesse? Return True Else ~@Form_alert(1,"[3][|Op‚ration impossible avec |un MoDem! |][ Annuler ]") Return False Endif Endfunc ' send format‚ Procedure Send(Message$) ' Local A& ' @Waitout1 If Online! Or Redir! If Redir! @Hidem Endif ' If Slow!=False And Ascii&=0 If (Redir!=False) And (Not Lim1200!) ' Print #5,@Tran$(Message$); @Tran(Message$) Print #5,Tr_t$; Else Send2(Message$) Endif ' Else ' ' 7.5c/sec For Sd_a&=1 To Len(Message$) $S& Select Ascii& Case 1 Select Asc(Mid$(Message$,Sd_a&,1)) Case 0 To 15 Send2("$0"+Hex$(Asc(Mid$(Message$,Sd_a&,1)))) Case 0 To 26,28 To 31 Send2("$"+Hex$(Asc(Mid$(Message$,Sd_a&,1)))) Case 27 Send2("#") Case "#" ' Send2("##") Send2("$23") Case "$" ' Send2("$$") Send2("$24") Default Send2(Mid$(Message$,Sd_a&,1)) Endselect Case 2 Select Asc(Mid$(Message$,Sd_a&,1)) Case 0 To 26,28 To 31 Send2("$"+Chr$(64+Asc(Mid$(Message$,Sd_a&,1)))) Case 27 Send2("#") Case "#" Send2("##") Case "$" Send2("$$") Default Send2(Mid$(Message$,Sd_a&,1)) Endselect ' Default Send2(Mid$(Message$,Sd_a&,1)) Endselect $S% ' Next Sd_a& ' Endif ! slow Endif ! online ' Return Procedure Send2(Message$) ' Local A&,Flag! ' If Redir! Sd_a!=False If @Firstw=4 Sd_a!=True Else If @W_tstview(4) ! mais voit-on la fenˆtre totalement? Sd_a!=True Endif Endif Endif ' For Sd_a2&=1 To Len(Message$) If Slow! @Pause(7) ! 7.5c/s eh oui sur 10 bits! Endif If Not Redir! ' Print #5,@Tran$(Mid$(Message$,sd_a,1)); @Tran(Mid$(Message$,Sd_a2&,1)) Print #5,Tr_t$; Else Gosub Emanage(Sd_a!,Asc(Mid$(Message$,Sd_a2&,1))) If Redt|=1 ! aussi!! ' Print #5,@Tran$(Mid$(Message$,sd_a,1)); @Tran(Mid$(Message$,Sd_a2&,1)) Print #5,Tr_t$; Endif Endif Next Sd_a2& If Lim1200! Add L1200&,Len(Message$) ! limiteur de vitesse If L1200&>20 Waitimer Endif Endif If Redir! @Sweety_text Endif Return Procedure Waitimer ' Local T% ' ' wait ' ' While (Timer-T%)<(1/120)*200*L1200& Gosub Defmouse(2) While (Timer-Sd_t%)<(200*L1200&)/120 Exit if Btst(@Bios11,2) Wend Clr L1200& Sd_t%=Timer ' Return ' ' envoi de commandes hayes Procedure Atsend(E$) Local A& ' Gosub Defmouse(2) A&=1 Do $S& Select Mid$(E$,A&,1) Case "," Delay 0.25 Case "\" Select Mid$(E$,A&+1,1) Case "a" Print #5,Chr$(7); Inc A& Case "b" Print #5,Chr$(8); Inc A& Case "f" Print #5,Chr$(12); Inc A& Case "n" Print #5,Chr$(10); Inc A& Case "r" Print #5,Chr$(13); Inc A& Case "\" Print #5,"\"; Inc A& Case "," Print #5,","; Inc A& Default Print #5,Mid$(E$,A&,1); Endselect Case "+" Print #5,"+"; Delay 0.1 Default Print #5,Mid$(E$,A&,1); Endselect $S% Inc A& Loop until A&>Len(E$) Gosub Defmouse(0) ' Return ' ' send absolu Procedure Outvid(Message$) @Waitout1 If Online! ' Print #5,@Tran$(Message$); @Tran(Message$) Print #5,Tr_t$; Endif Return Procedure Videmntl While Bios(1,1) ~Bios(2,1) Wend Xin_read&=0 Return Function Red_alert(X&,E$) $F% Local A&,B& ' ' ~@Wind_update01(1) ' Contrl(0)=38 ' Contrl(1)=0 ' Contrl(3)=0 ' Contrl(6)=Graf_handle() ' Vdisys ' B&=Intout(1) ' ' Contrl(0)=22 ' Contrl(1)=0 ' Contrl(3)=1 ' Contrl(6)=Graf_handle() ' Intin(0)=2 ' Vdisys ' ~@Wind_update01(0) ' A&=@Form_alert(X&,E$) ' ' ~@Wind_update01(1) ' Contrl(0)=22 ' Contrl(1)=0 ' Contrl(3)=1 ' Contrl(6)=Graf_handle() ' Intin(0)=B& ' Vdisys ' ~@Wind_update01(0) ' Return A& Endfunc Function Green_alert(X&,E$) $F% Local A&,B& ' ' ~@Wind_update01(1) ' Contrl(0)=38 ' Contrl(1)=0 ' Contrl(3)=0 ' Contrl(6)=Graf_handle() ' Vdisys ' B&=Intout(1) ' ' Contrl(0)=22 ' Contrl(1)=0 ' Contrl(3)=1 ' Contrl(6)=Graf_handle() ' Intin(0)=3 ' Vdisys ' ~@Wind_update01(0) ' A&=@Form_alert(X&,E$) ' ' ~@Wind_update01(1) ' Contrl(0)=22 ' Contrl(1)=0 ' Contrl(3)=1 ' Contrl(6)=Graf_handle() ' Intin(0)=B& ' Vdisys ' ~@Wind_update01(0) ' Return A& Endfunc Function Form_ok_scr(X&,E$) $F% Local A&,B& ' If Edited!(0) A&=@Red_alert(1,E$) Else A&=X& Endif ' Return A& Endfunc Function Form_ok_grf(X&,E$) $F% Local A&,B& ' If Edited!(1) A&=@Green_alert(1,E$) Else A&=X& Endif ' Return A& Endfunc Function Bold_alert(X&,E$) $F% Local B&,A& ' ' Contrl(0)=106 ' Contrl(1)=0 ' Contrl(3)=1 ' Contrl(6)=Graf_handle() ' Intin(0)=&X101 ' Vdisys ' A&=@Form_alert(X&,E$) ' ' Contrl(0)=106 ' Contrl(1)=0 ' Contrl(3)=1 ' Contrl(6)=Graf_handle() ' Intin(0)=0 ' Vdisys ' Return A& ' Endfunc ' Procedure Waitout1 Local A& ' If @Outok1 Online!=True Else A&=0 While @Outok1=0 And A&<=100 ~Evnt_timer(10) Inc A& Wend If A&>100 Online!=False Else Online!=True Endif Endif ' Return ' Function Outok1 $F% ' Return True ! ‚mission toujours okay (...) Endfunc ' ' Evite les clics 'fantomes' -> trrrrrrŠs pratique ... Procedure Caremouse Local X&,A&,Mk& ' While @Xmousek<>0 Wend ' ' vider "buffer clic" ~Evnt_multi(&X100010,256,3,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),10) Do X&=False A&=False A&=Evnt_multi(&X100010,0,1,1,X&,X&,X&,X&,X&,X&,X&,X&,X&,X&,X&,10) Loop until Btst(A&,1)=False ! Evnt Button Return Procedure Waitmouse Local A& ' A&=@Xmousek If A&<>0 While @Xmousek=A& Wend Endif Return ' Procedure Tran(Message$) ' Local A&,B&,T$ ' If Len(Message$)>0 Clr Tr_t$ Tr_a&=1 Repeat Tr_b&=Asc(Mid$(Message$,Tr_a&,1)) $S& Select Tr_b& ' Case "‚" Tr_t$=Tr_t$+Chr$(25)+"Be" Case "…" Tr_t$=Tr_t$+Chr$(25)+"Aa" Case "Š" Tr_t$=Tr_t$+Chr$(25)+"Ae" Case "—" Tr_t$=Tr_t$+Chr$(25)+"Au" Case "„" Tr_t$=Tr_t$+Chr$(25)+"Ha" Case "‰" Tr_t$=Tr_t$+Chr$(25)+"He" Case "‹" Tr_t$=Tr_t$+Chr$(25)+"Hi" Case "”" Tr_t$=Tr_t$+Chr$(25)+"Ho" Case "š" Tr_t$=Tr_t$+Chr$(25)+"Hu" Case "ƒ" Tr_t$=Tr_t$+Chr$(25)+"Ca" Case "ˆ" Tr_t$=Tr_t$+Chr$(25)+"Ce" Case "Œ" Tr_t$=Tr_t$+Chr$(25)+"Ci" Case "“" Tr_t$=Tr_t$+Chr$(25)+"Co" Case "–" Tr_t$=Tr_t$+Chr$(25)+"Cu" Case "‡" Tr_t$=Tr_t$+Chr$(25)+"Kc" Case "´" Tr_t$=Tr_t$+Chr$(25)+"z" Case "µ" Tr_t$=Tr_t$+Chr$(25)+"j" Case "Ý" Tr_t$=Tr_t$+Chr$(25)+"'" Case "œ" Tr_t$=Tr_t$+Chr$(25)+"#" Case "¬" Tr_t$=Tr_t$+Chr$(25)+"<" Case "«" Tr_t$=Tr_t$+Chr$(25)+"=" Case "þ" Tr_t$=Tr_t$+Chr$(25)+">" Case "¯" Tr_t$=Tr_t$+Chr$(25)+"." Case "®" Tr_t$=Tr_t$+Chr$(25)+"," Case "ž" Tr_t$=Tr_t$+Chr$(25)+"{" Case "ñ" Tr_t$=Tr_t$+Chr$(25)+"1" Case "ö" Tr_t$=Tr_t$+Chr$(25)+"8" Case "ø" Tr_t$=Tr_t$+Chr$(25)+"0" Case "ÿ" Tr_t$=Tr_t$+"~" ' ' Pas d'eqv: Case "¶" Tr_t$=Tr_t$+"A" Case "" Tr_t$=Tr_t$+"E" Case "Ž" Tr_t$=Tr_t$+"A" Case "™" Tr_t$=Tr_t$+"O" Case "š" Tr_t$=Tr_t$+"U" Case "€" Tr_t$=Tr_t$+"C" ' Case 0 To 127 Tr_t$=Tr_t$+Chr$(Tr_b&) Case 128 To Tr_t$=Tr_t$+Chr$(Bclr(Tr_b&,127)) ' Endselect $S% ' Inc Tr_a& Until Tr_a&>Len(Message$) Else Clr Tr_t$ Endif ' ' Return Tr_t$ ' Endfunc Return ' ' Input minitel Inp(1), gŠre les chars sp‚ciaux (‚Šˆ‰ etc..) $P< Function Xinp1 $F% ' Local A&,B&,C&,Reponse& ' Local T& ' If Xin_read&=0 Xin_a&=Bios(2,1) If Xin_a&=25 Or Xin_a&=22 If Not Bios(1,1) Pause 10 If Not Bios(1,1) Return Xin_a& Endif Endif Xin_b&=Bios(2,1) Select Xin_b& ' Case "A","B","C","H","K" ' If Not Bios(1,1) Pause 10 If Not Bios(1,1) Xin_read&=Xin_b& Return Xin_a& Endif Endif Xin_c&=Bios(2,1) Select Chr$(Xin_b&)+Chr$(Xin_c&) ' Case "Be" Return Asc("‚") Case "Aa" Return Asc("…") Case "Ae" Return Asc("Š") Case "Au" Return Asc("—") Case "Ha" Return Asc("„") Case "He" Return Asc("‰") Case "Hi" Return Asc("‹") Case "Ho" Return Asc("”") Case "Hu" Return Asc("š") Case "Ca" Return Asc("ƒ") Case "Ce" Return Asc("ˆ") Case "Ci" Return Asc("Œ") Case "Co" Return Asc("“") Case "Cu" Return Asc("–") Case "Kc" Return Asc("‡") Default Return Xin_c& Endselect ' Case "z" Return Asc("´") Case "j" Return Asc("µ") Case "'" Return Asc("Ý") Case "#" Return Asc("œ") Case "<" Return Asc("¬") Case "=" Return Asc("«") Case ">" Return Asc("þ") Case "." Return Asc("¯") Case "," Return Asc("®") Case "{" Return Asc("ž") Case "1" Return Asc("ñ") Case "8" Return Asc("ö") Case "0" Return Asc("ø") Default Xin_read&=Xin_b& ! ca sera le suivant! Return Xin_a& Endselect ' Else Return Xin_a& Endif Else Xin_a&=Xin_read& Clr Xin_read& Return Xin_a& Endif ' Return Reponse& Endfunc $P> ' ' ' Indente tout le texte, proc‚dure (assez) rapide (<1 seconde) Procedure Indentage Local A& ' Void Fre(0) For A&=0 To Maxty&+1 Pag_len&(A&)=Len(Page$(A&)) Pag_adr%(A&)=Varptr(Page$(A&)) Next A& Void C:Indent%(L:V:Pag_adr%(0),L:V:Pag_len&(0),L:V:Pag_ind&(0),Maxty&,Dims&) ' Return ' ' ' $P< ' Function Timing ' $F% ' ' ' If Timer-Tm%>Set_mtime%*15 ' Tm%=Timer ' Return True ' Endif ' ' ' Return False ' Endfunc ' $P> ' Procedure Infoc If Aff! Add W%,(Timer-W2%) Menu.info("Compiler - [SHIFT]-[SHIFT] pour interrompre. L"+Str$(A%)+" T"+Str$(H%)) W2%=Timer If Not Set_multi! ~@Wind_update01(1) Endif Endif Return ' ' Index: True tout False ascii Function Compile(Flag!,Opt!) $F% Local A&,C&,D&,X&,Y&,E$,A$,T$,B$,Resultat#,Ityp| Local Stav$,Stas$,Stal$,Stan$,Stat$,Nextstr$ Local Xproc$ ! getsion des procs: catalogue/gestion Local W%,W2%,H%,Count% ! timing Local Grmode! ! mode graphique Local Star!,Star$ ! block Local Instr& Local Aff! ! afficher timing? Local B& ! octets sauv‚s par OPT Local Chr_asc! ! pour compile ascii: TRUE-> ligne de caractŠre comenc‚e Local Direct! ! pour stocker directement (sans nextstr$) ' FALSE->codes spec ou espace Local Ptg$ ' ' If Fre(0)0 And Y&<>True Dec Y& Else Y&=-1 Exit if True Endif Case "ELSE" If Y&<=0 Y&=-2 Exit if True Endif Case "FOR ","FORS" Inc X& Case "REPE" ' If Mid$(Page$(A&),5,2)="AT" Inc X& ' Endif Case "PROC" If C&=0 If X&=0 And Y&=0 Inc C& ' PROCEDURE truc T$=Mid$(Page$(A&),11) If Instr(T$,")")<>0 ! params? T$=Mid$(T$,1,Instr(T$,")")) Endif If @Test9(T$) B$=T$ ' ' 2 octets=pos, "@"+x octets=nom+params, 3 octets= barriŠres (instr) B$=Mid$(Trim$(Upper$(B$)),1,255) If Instr(B$,"(")<>0 B$=Left$(B$,Instr(B$,"(")-1)+"+"+Mid$(B$,Instr(B$,"(")) Else B$=B$+"+" Endif ' If Len(B$)=0 ! "" C&=-4 Exit if True Else If Instr(Proc$,Chr$(32)+"@"+B$)<>0 C&=-3 Exit if True Else For D&=1 To Len(B$) Select Asc(Mid$(B$,D&,1)) Case 0 To 31 C&=-4 Endselect Next D& ' If C&>0 ' position= 2 premiers octets Proc$=Proc$+Mki$(A&)+Chr$(32)+"@"+B$+Chr$(32) Endif Endif Endif ' Clr A$,B$ Else If Len(Terr$)=0 Terr$="Erreur"+" dans la chaine" Endif Exit if True Endif ' Else C&=-2 Exit if True Endif Else Inc C& Exit if True Endif Case "RETU" If C&<>0 Dec C& Else C&=-1 Exit if True Endif Default $S% Select Left$(T$,2) Case "IF" Inc Y& Case "DO" If Mid$(T$,3,1)=Chr$(32) Inc X& Endif Endselect Endselect Next A& ' Gosub Comm.info("M","*Compiler -") If Y&=0 If X&=0 If C&=0 ' Clr A$,B$ Edited!(Actb&+3)=True Binair$(Actb&)="" Star$="" ! bloc Tr%=False ! Transparence Mask%=False Clr Every$ Every&=0 Redo%=0 Clr Nextstr$ Prodo%=0 ! profondeur du do ' ' Clr Stav$,Stan$,Stats$,Stal$,Stat$ For A&=0 To 50 Stav$(A&)="" ! Effacer buffer variables de ctrl Next A& Clr Stan$,Stats$,Stal$,Stat$ Clr Stav%,Stan%,Stas%,Stal%,Stat% Clr Stan%,Stas%,Stal%,Stat% Clr Grmode! ! texte Clr Com_rol! ! rouleau off Clr Star! Clr Chr_asc! ' ' 1ko gestion boucle: 50 de profondeur ' Stav%=1 ' Stav$=Space$(52) ! 1 ' Stan%=1 Stan$=Space$(416) ! 8 ' Stas%=1 Stas$=Space$(416) ! 8 ' Stal%=1 Stal$=Space$(108) ! 2 ' Stat%=1 Stat$=Space$(52) ! 1 ' If Dim?(Pr#()) Erase Pr#(),Pr$() Endif Dim Pr#(Dinstr&),Pr$(Dinstr&) Void Fre(0) ' W2%=Timer ! timing W%=0 H%=0 ! total de lignes Count%=0 ! compteur de lignes B&=0 ! saved bytes ' ' ' ' ' ' If Aff! Menu.info("Compiler - [SHIFT]-[SHIFT] pour interrompre. L0 T0") Else Menu.info("Compiler - [SHIFT]-[SHIFT] pour interrompre. Pas d'infos.") Endif A&=0 ! boucle ' ' ////////////////////////////////////////////////// Do ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Inc Count% ! (info plus un) ' T$=Page$(A&) ' ' For X&=0 To MaxTy&+1 ' Pag_len&(X&)=Len(Page$(X&)) ' Pag_adr%(X&)=Varptr(Page$(X&)) ' Next X& ' ' X&=Len(Binair$(Actb&)) ' A&=C:Blitc%(L:V:Pag_adr%(0),L:V:Pag_len&(0),MaxTy&-1,A&,L:V:Binair$(Actb&),L:X&,L:32000) ' ' ++ If Len(T$)>0 And Left$(T$,1)<>"'" If And(Len(Page$(A&))>0,Peek(Varptr(Page$(A&)))<>39) ! 39=' ' Clr Nextstr$ ! bloc cplx ' Stockage direct? Direct!=((Redo%+Mask%+Every&+Tr%=0) And (Not Star!) And (Flag!) And (Not Autosend!)) Inc H% ' If Mod(Count%,8)=0 If Not Set_multi! ! not multi Gosub Defmouse(2) ! anim Endif ' If Fre()0 And X&0 ' C'est une assignation! (TRUC=MACHIN) C&=-1 ! Not‚! ' Else ' If C&=0 E$=Page$(A&) ! instr Clr A$ ! pas de params X&=False ' Else E$=Left$(Page$(A&),C&-1) ! instr A$=Mid$(Page$(A&),C&+1) ! params ' Endif Clr C& Endif ' If C&=-1 ! assignation ' Etest!=False E$=Left$(Page$(A&),X&-1) A$=Mid$(Page$(A&),X&+1) If Left$(E$,1)="$" Or Right$(E$,1)="$" ' Alpha A$=@Evals$(A$) If Terrp&=0 @Vsset(E$,A$) Else Exit if True Endif Else ! assign num‚rique @Vnset(E$,@Calc(A$)) Exit if Terrp&<>0 ' Endif ' Else Select Left$(Page$(A&),1) Case "@" ! proc ' ' Effacer PaRamŠtres d'instructions (->Propar$->Pile) For X&=0 To 5 Pr#(X&)=0 Pr$(X&)="" Next X& ' C&=@Pproc(Mid$(E$,2,Len(E$)-1)) If C&<>-1 ! trouv‚e ' E$="@@"+Mki$(C&) ! nom-> @@ (proc) + No ligne C&=Istr& ! on traite comme une instruction Clr D& Else If Len(Terr$)=0 Terr$="PROCEDURE"+" introuvable" Endif Exit if True Endif ' ' Case "{","}","\" ! Dummy C&=-2 ! sauter ' Default ! instruction normale ' C&=1 Do ' C&=Instr(Instr.tab$,Chr$(32)+E$+Chr$(32)) C&=Instr(Instr.tab$,Chr$(32)+Left$(E$,Tabi&-1)+Chr$(32),C&) Exit if C&=0 Inc C& If Mid$(Instr.tab$,C&-1,1)=Chr$(32) Dec C& Exit if True Endif Loop If C&<>0 Div C&,Tabi& ! pos Else C&=-1 Endif Endselect ' ' If Len(Instr$(A&,0))>0 If C&=>0 ' Ityp|=Tpi|(C&) ! typer d'instr voir datas ' D&=0 While Instr&(C&,D&)>0 ' ' Lire le paramŠtre B$=@Readp$(A$) If Len(A$)=Len(B$) ! Fin de chaine Clr A$ Else A$=Mid$(A$,Len(B$)+2) Endif ' $S& Select Instr&(C&,D&) Case 4 ' (t$ ne sert plus a rien ici) T$=Page$(A&) If @Vals(False,B$,T$)<>0 Pr$(D&)=T$ Else ~@Wind_update01(0) If Len(Terr$)=0 Terr$="Mauvais type de paramŠtre"+" string" Endif Exit if True Endif Case 2,3,8 If @Valx(False,B$,Resultat#)<>0 ' Select Instr&(C&,D&) Case 2 Pr#(D&)=Int(Resultat#) If Pr#(D&)<-128 Or Pr#(D&)>255 Terr$="Le nombre n'est pas un octet -128..255" Exit if True Endif Case 8 Pr#(D&)=Int(Resultat#) If Pr#(D&)<1 Or Pr#(D&)>63 Terr$="Le nombre n'est pas compris entre 1..63" Exit if True Endif Default Pr#(D&)=Resultat# Endselect ' Else ~@Wind_update01(0) If Len(Terr$)=0 Terr$="Mauvais type de paramŠtre"+" integer" Endif Exit if True Endif ' ' paramx: 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc Case 1 If B$="ON" Pr#(D&)=True Else if B$="OFF" Pr#(D&)=False Endif Case 7 ! col Pr$(D&)=B$ Select @Valcol(False,0,B$) Case "@" Pr#(D&)=0 Case "D" Pr#(D&)=1 Case "A" Pr#(D&)=2 Case "E" Pr#(D&)=3 Case "B" Pr#(D&)=4 Case "F" Pr#(D&)=5 Case "C" Pr#(D&)=6 Case "G" Pr#(D&)=7 Endselect ' Case 5,6,9 Pr$(D&)=B$ ! inutile ' Case 5 ! VAR ' Pr$(D&)=B$ ! Noter var ' Case 6 ! $VAR ' Pr$(D&)=B$ ! Noter var ' Endselect ! of select instr(c,d) $S% ' B$=Trim$(B$) Inc D& Exit if D&>Dinstr& Wend Exit if Len(Terr$)>0 ' Else if C&=-2 ! Dummy ' Else Terr$="Instruction "+"inconnu"+"e!" Modify!=True ! ligne … v‚rifier Exit if True Endif ' ' On passe a l'analyse: ' E$ instruction ' Pr#(i..) et Pr$(i..) : paramŠtres d'index i $S% Select Left$(E$,2) ! esc-ce un If? ' Case "{","}","\" ! dummy ' Case "@@" ! proc ' ' Tout simple! e$=instruction '@@truc' Xproc$=Mki$(A&)+Xproc$ ! retour For X&=0 To 9 Propar$=Mkd$(Procx#(X&))+Propar$ Propar$=Mki$(Len(Proc$(X&)))+Proc$(X&)+Propar$ Next X& For X&=0 To 9 Procx#(X&)=0 Proc$(X&)="" Next X& ' If Len(Xproc$)<=2000 A&=Cvi(Mid$(E$,3,2)) ! plus 1 For X&=0 To Dinstr& Procx#(X&)=Pr#(X&) Proc$(X&)=Pr$(X&) Next X& ' Else Terr$="Stack error, @ trop profond" Exit if True Endif ' ' select pour ne pas mettre if (perte de temps) Case "IF" ' If Left$(E$,2)="IF" ! esc-ce un If? ' X&=0 ! Cond non remplie If Len(E$)=2 X&=Pr#(0) Else if Len(E$)=3 ! IFS X&=(Pr$(0)=Pr$(1)) ' Else Select Mid$(E$,3,3) ' Case "EQ" X&=(Pr#(0)=Pr#(1)) Case "NE" X&=(Pr#(0)<>Pr#(1)) Case "LO" X&=(Pr#(0)Pr#(1)) Case "HS" X&=(Pr#(0)=>Pr#(1)) ' Case "EQS" X&=(Pr$(0)=Pr$(1)) Case "NES" X&=(Pr$(0)<>Pr$(1)) ' ' n'est plus utilis‚ Case "LOS" X&=(Len(Pr$(0))Len(Pr$(1))) Case "HSS" X&=(Len(Pr$(0))=>Len(Pr$(1))) ' Default Terr$="If erron‚" Exit if True Endselect Endif ' If Not X& ! non remplie: sauter ' For Y&=A& To MaxTy&-1 Y&=A&+1 X&=1 ! nbre de ifs que l'on doit sauter Do If X&=1 If Left$(Page$(Y&),4)="ELSE" Dec X& Endif Endif If Left$(Page$(Y&),4)="ENDI" Dec X& Else if Left$(Page$(Y&),2)="IF" Inc X& ! encore un! Endif Inc Y& Loop until Y&>Maxty&-1 Or X&=0 If Y&>Maxty&-1 Terr$="If sans endifs" Exit if True Endif ' Next Y& A&=Y&-1 Endif ' ' Else ' :::::::::: Default ' :::::::::: ' Ce n'est pas un if, alors on conrinue l'analyse: ' ::::::::::::::::::::::::::::::::::::::::::::::::::::::: ' $S% Select Left$(E$,4) ! 4 premiers octets ' ' Main instr. Case "TXT" If Len(Pr$(0))>32000-Len(Binair$(Actb&)) Terr$="Bloc VDT 32K plein" Exit if True Else If Direct! Binair$(Actb&)=Binair$(Actb&)+Pr$(0) ! (Instruction la + utilis‚e) Else Nextstr$=Pr$(0) ! (Instruction la + utilis‚e) Endif ' Endif ' Case "CLS" Grmode!=False If Direct! Binair$(Actb&)=Binair$(Actb&)+Cls$ Else Nextstr$=Cls$ Endif Case "MAJ" If Direct! Binair$(Actb&)=Binair$(Actb&)+Maj$ Else Nextstr$=Maj$ Endif Case "MIN" If Direct! Binair$(Actb&)=Binair$(Actb&)+Min$ Else Nextstr$=Min$ Endif Case "40CO" Grmode!=False If Direct! Binair$(Actb&)=Binair$(Actb&)+Col40$ Else Nextstr$=Col40$ Endif Case "F80C" Grmode!=False If Direct! Binair$(Actb&)=Binair$(Actb&)+Col80$ Else Nextstr$=Col80$ Endif Case "A80C" Grmode!=False If Direct! Binair$(Actb&)=Binair$(Actb&)+Col80a$ ! am‚ricain Else Nextstr$=Col80a$ ! am‚ricain Endif Case "DRCT" ! Drcs txt If Pr#(0)=True If Direct! Binair$(Actb&)=Binair$(Actb&)+Drcton$ Else Nextstr$=Drcton$ Endif Else If Direct! Binair$(Actb&)=Binair$(Actb&)+Drctoff$ Else Nextstr$=Drctoff$ Endif Endif Case "DRCG" ! Drcs grf If Pr#(0)=True If Direct! Binair$(Actb&)=Binair$(Actb&)+Drcgon$ Else Nextstr$=Drcgon$ Endif Else If Direct! Binair$(Actb&)=Binair$(Actb&)+Drcgoff$ Else Nextstr$=Drcgoff$ Endif Endif Case "TLDR" ! stload text If Direct! Binair$(Actb&)=Binair$(Actb&)+Ldt$ Else Nextstr$=Ldt$ Endif Case "GLDR" ! stload graph If Direct! Binair$(Actb&)=Binair$(Actb&)+Ldg$ Else Nextstr$=Ldg$ Endif Case "ENDT" ! end tel drcs If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(31)+"ZZ" ! pos bidon (pas de pos) Else Nextstr$=Chr$(31)+"ZZ" ! pos bidon (pas de pos) Endif Case "DRSE" ! set next character to load If Len(Pr$(0))=1 Select Left$(Pr$(0),1) Case "!" To "~" ! 33..126 If Direct! Binair$(Actb&)=Binair$(Actb&)+Mki$(&H1F23)+Pr$(0)+"0" Else Nextstr$=Mki$(&H1F23)+Pr$(0)+"0" Endif Default Terr$="CaractŠre non t‚l‚chargeable: "+Pr$(0) Exit if True Endselect Else if Len(Pr$(0))>$ And And And And Imp $ And Left$( Or Inpaux$ And <>"DRSET d‚clare un caractŠre UNIQUE … t‚l‚charger!" Terr$="DRSET d‚clare un caractŠre UNIQUE … t‚l‚charger!" Exit if True Else Terr$="DRSET attend un caractŠre … d‚clarer pour t‚l‚charger!" Exit if True Endif ' Case "KEY" ! key on/off If Pr#(0)=True If Direct! Binair$(Actb&)=Binair$(Actb&)+Kon$ Else Nextstr$=Kon$ Endif Else If Direct! Binair$(Actb&)=Binair$(Actb&)+Koff$ Else Nextstr$=Koff$ Endif Endif Case "CLL" Grmode!=False If Direct! Binair$(Actb&)=Binair$(Actb&)+Cll$ Else Nextstr$=Cll$ Endif Case "SPAC" ! e If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(32) Else Nextstr$=Chr$(32) Endif Case "NULL" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(0) Else Nextstr$=Chr$(0) Endif Case "RESE" ! t Grmode!=False If Direct! Binair$(Actb&)=Binair$(Actb&)+Reset$ Else Nextstr$=Reset$ Endif Case "TEXT" ! e If Grmode!=True Or Opt!<>True If Direct! Binair$(Actb&)=Binair$(Actb&)+Text$ Else Nextstr$=Text$ Endif Else Inc B& Endif Grmode!=False Case "GRAP" ! hique If Grmode!=False Or Opt!<>True If Direct! Binair$(Actb&)=Binair$(Actb&)+Graph$ Else Nextstr$=Graph$ Endif Else Inc B& Endif Grmode!=True Case "BEEP" If Direct! Binair$(Actb&)=Binair$(Actb&)+Beep$ Else Nextstr$=Beep$ Endif Case "CR" If Direct! Binair$(Actb&)=Binair$(Actb&)+Cr$ Else Nextstr$=Cr$ Endif Case "CR2" If Direct! Binair$(Actb&)=Binair$(Actb&)+Cr2$ Else Nextstr$=Cr2$ Endif Case "CRH" If Direct! Binair$(Actb&)=Binair$(Actb&)+Crt$+C_h$ Else Nextstr$=Crt$+C_h$ Endif Case "CRT" If Direct! Binair$(Actb&)=Binair$(Actb&)+Crt$ Else Nextstr$=Crt$ Endif Case "HOME" Grmode!=False If Direct! Binair$(Actb&)=Binair$(Actb&)+Home$ Else Nextstr$=Home$ Endif Case "FILL" If Direct! Binair$(Actb&)=Binair$(Actb&)+Bl$ Else Nextstr$=Bl$ Endif ' Case "HAUT" If Direct! Binair$(Actb&)=Binair$(Actb&)+C_h$ Else Nextstr$=C_h$ Endif Case "BAS" If Direct! Binair$(Actb&)=Binair$(Actb&)+C_b$ Else Nextstr$=C_b$ Endif Case "GAUC" ! he If Direct! Binair$(Actb&)=Binair$(Actb&)+C_g$ Else Nextstr$=C_g$ Endif Case "DROI" ! te If Direct! Binair$(Actb&)=Binair$(Actb&)+C_d$ Else Nextstr$=C_d$ Endif ' Case "CURS" ! eur If Pr#(0)=True If Direct! Binair$(Actb&)=Binair$(Actb&)+Curson$ Else Nextstr$=Curson$ Endif Else If Direct! Binair$(Actb&)=Binair$(Actb&)+Cursoff$ Else Nextstr$=Cursoff$ Endif Endif Case "ROUL" ! eau If Pr#(0)=True Com_rol!=True If Direct! Binair$(Actb&)=Binair$(Actb&)+Roulon$ Else Nextstr$=Roulon$ Endif Else Com_rol!=False If Direct! Binair$(Actb&)=Binair$(Actb&)+Rouloff$ Else Nextstr$=Rouloff$ Endif Endif Case "FLAS" ! h If Pr#(0)=True If Direct! Binair$(Actb&)=Binair$(Actb&)+Flash$ Else Nextstr$=Flash$ Endif Else If Direct! Binair$(Actb&)=Binair$(Actb&)+Flashoff$ Else Nextstr$=Flashoff$ Endif Endif Case "MASQ" If Pr#(0)=True If Direct! Binair$(Actb&)=Binair$(Actb&)+Mask$ Else Nextstr$=Mask$ Endif Else If Direct! Binair$(Actb&)=Binair$(Actb&)+Maskend$ Else Nextstr$=Maskend$ Endif Endif Case "MASK" ! next Mask%=Int(Pr#(0)) Case "EVER" ! y Every&=Int(Pr#(0)) Every$=Pr$(1) Case "EVST" Tr%=False ! Transparence Mask%=False Clr Every$ Every&=0 Redo%=0 Clr Nextstr$ Case "MONT" ! rer If Direct! Binair$(Actb&)=Binair$(Actb&)+Allume$ Else Nextstr$=Allume$ Endif Case "CACH" ! her If Direct! Binair$(Actb&)=Binair$(Actb&)+Eteint$ Else Nextstr$=Eteint$ Endif Case "LINE" If Pr#(0)=True If Direct! Binair$(Actb&)=Binair$(Actb&)+Line$ Else Nextstr$=Line$ Endif Else If Direct! Binair$(Actb&)=Binair$(Actb&)+Lineoff$ Else Nextstr$=Lineoff$ Endif Endif Case "INVE" ! rse If Pr#(0)=True If Direct! Binair$(Actb&)=Binair$(Actb&)+Inverse$ Else Nextstr$=Inverse$ Endif Else If Direct! Binair$(Actb&)=Binair$(Actb&)+Inverseoff$ Else Nextstr$=Inverseoff$ Endif Endif ' Case "POS" Grmode!=False Pr#(0)=Int(Pr#(0)) Pr#(1)=Int(Pr#(1)) If Opt!=True And Com_rol!=False If Pr#(0)=1 If Pr#(1)=1 ! Home If Direct! Binair$(Actb&)=Binair$(Actb&)+Home$ Else Nextstr$=Home$ Endif Add B&,2 Else if Pr#(1)=2 ! Pos 1,2 If Direct! Binair$(Actb&)=Binair$(Actb&)+Home$+C_b$ Else Nextstr$=Home$+C_b$ Endif Inc B& Else if Pr#(1)=24 ! Pos 1,24 If Direct! Binair$(Actb&)=Binair$(Actb&)+Home$+C_h$ Else Nextstr$=Home$+C_h$ Endif Inc B& ' Else If Direct! Binair$(Actb&)=Binair$(Actb&)+@Pos$(Int(Pr#(0)),Int(Pr#(1))) Else Nextstr$=@Pos$(Int(Pr#(0)),Int(Pr#(1))) Endif Endif ' Else if Pr#(0)=2 And Pr#(1)=1 ! Pos 2,1 If Direct! Binair$(Actb&)=Binair$(Actb&)+Home$+C_d$ Else Nextstr$=Home$+C_d$ Endif Inc B& Else if Pr#(0)=40 And Pr#(1)=24 ! Pos 40,24 If Direct! Binair$(Actb&)=Binair$(Actb&)+Home$+C_g$ Else Nextstr$=Home$+C_g$ Endif Inc B& ' Else If Direct! Binair$(Actb&)=Binair$(Actb&)+@Pos$(Int(Pr#(0)),Int(Pr#(1))) Else Nextstr$=@Pos$(Int(Pr#(0)),Int(Pr#(1))) Endif Endif Else If Opt!=True If Com_rol!=True Gosub Comp.info("C","Attention POS non optimis‚ avec ROULEAU ON * L:"+Str$(A&)) Endif Endif If Direct! Binair$(Actb&)=Binair$(Actb&)+@Pos$(Int(Pr#(0)),Int(Pr#(1))) Else Nextstr$=@Pos$(Int(Pr#(0)),Int(Pr#(1))) Endif Endif ' Case "OUT" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(Int(Pr#(0))) Else Nextstr$=Chr$(Int(Pr#(0))) Endif ' Case "INCB" ! in Pr$(0)=Trim$(Pr$(0)) Menu.info("Compiler - [SHIFT]-[SHIFT] pour interrompre. L"+Str$(A&)+" T"+Str$(H%)+" loading "+Pr$(0)) If Not @Exist(Pr$(0)) ' If Set_multi! ' @Top(1) ' @Rdw_all(1) ' Endif File$(2)=Upper$(Trim$(Pr$(0))) Gosub Comp.info("C","IncBin: s‚lection") Add W%,(Timer-W2%) ~@Wind_update01(0) File$(2)=Upper$(Trim$(File$(2))) File$(2)=@Fsel$("\*.VDT",File$(2),"Fusionner fichier VDT") Pr$(0)=File$(2) If Not Set_multi! ~@Wind_update01(1) Endif W2%=Timer Endif If @Exist(Pr$(0)) Open "I",#1,Pr$(0) If Lof(#1)+Len(Binair$(Actb&))<32000 If Direct! Binair$(Actb&)=Binair$(Actb&)+Input$(Lof(#1),#1) Else Nextstr$=Input$(Lof(#1),#1) Endif Else Close #1 Terr$="Bloc VDT 32K plein" Exit if True Endif Close #1 Else Terr$="Fichier "+Pr$(0)+" introuvable" Exit if True Endif ' Case "ENCR" ! e X&=@Valcol(False,0,B$) If X&<>-1 If Direct! Binair$(Actb&)=Binair$(Actb&)+Esc$+Chr$(X&) Else Nextstr$=Esc$+Chr$(X&) Endif Else Terr$="Mauvaise couleur" Exit if True Endif ' Case "FOND" X&=@Valcol(False,1,B$) If X&<>-1 If Direct! Binair$(Actb&)=Binair$(Actb&)+Esc$+Chr$(X&) Else Nextstr$=Esc$+Chr$(X&) Endif Else Terr$="Mauvaise couleur" Exit if True Endif ' Case "SETV" ! var ' On simule les vars A..Z: Gosub Vnset(Chr$(Var#(Pr#(0))+64),Pr#(1)) ' ' ----- Case "SSET" ! XXX ' $S% Select Mid$(E$,5,4) ! 4 suivants ' Case "VAR" @Vsset(Chr$(Pr#(0)+64),Pr$(1)) ' Case "PAR" ! par Pr#(0)=Abs(@Xint(Pr#(0))) If Pr#(0)=>1 And Pr#(0)<=10 Proc$(Pr#(0)-1)=Pr$(1) Else If Pr#(0)>10 Terr$="@ Index de champ trop"+" grand" Else Terr$="@ Index de champ trop"+" petit" Endif Exit if True Endif ' Case "" ! sset @Vsset(Pr$(0),Pr$(1)) ' Endselect ' Case "SETP" ! ar Pr#(0)=Abs(@Xint(Pr#(0))) If Pr#(0)=>1 And Pr#(0)<=10 Procx#(Pr#(0)-1)=Pr#(1) Else If Pr#(0)>10 Terr$="@ Index de champ trop"+" grand" Else Terr$="@ Index de champ trop"+" petit" Endif Exit if True Endif Case "SET" ' Le nom de la var est dans Pr$(0): Gosub Vnset(Pr$(0),Pr#(1)) Case "CLR" Gosub Vndel(Pr$(0)) ! D‚truire Case "CLRS" Gosub Vsdel(Pr$(0)) ! D‚truire Case "ADDS" Gosub Vsset(Pr$(0),@Vsval$(Pr$(0))+Pr$(1)) Case "UPPE" ! rs Gosub Vsset(Pr$(0),Upper$(Pr$(0))) Case "TRIM" ! s Gosub Vsset(Pr$(0),Trim$(Pr$(0))) ' Case "GETC" ! har Pr#(0)=Max(0,Abs(Int(Pr#(0)))) Pr#(1)=Max(0,Abs(Int(Pr#(1)))) Pr#(2)=Max(0,Abs(Int(Pr#(2)))) ' Var$(Pr#(0))=Mid$(Pr$(2),Pr#(1),1) Gosub Vsset(Pr$(0),Mid$(Pr$(2),Pr#(1),1)) ' Case "ASCW" Pr#(0)=Max(0,Abs(Int(Pr#(0)))) Pr#(1)=Max(0,Abs(Int(Pr#(1)))) Pr#(2)=Max(0,Abs(Int(Pr#(2)))) ' Var#(Pr#(0))=Cvi(Mid$(Pr$(2),Pr#(1),2)) Gosub Vnset(Pr$(0),Cvi(Mid$(Pr$(2),Pr#(1),2))) ' Case "ASCL" Pr#(0)=Max(0,Abs(Int(Pr#(0)))) Pr#(1)=Max(0,Abs(Int(Pr#(1)))) Pr#(2)=Max(0,Abs(Int(Pr#(2)))) ' Var#(Pr#(0))=Cvl(Mid$(Pr$(2),Pr#(1),4)) Gosub Vnset(Pr$(0),Cvi(Mid$(Pr$(2),Pr#(1),4))) ' Case "ASC" Pr#(0)=Max(0,Abs(Int(Pr#(0)))) Pr#(1)=Max(0,Abs(Int(Pr#(1)))) Pr#(2)=Max(0,Abs(Int(Pr#(2)))) ' Var#(Pr#(0))=Asc(Mid$(Pr$(2),Pr#(1),1)) Gosub Vnset(Pr$(0),Asc(Mid$(Pr$(2),Pr#(1),1))) ' Case "GETS" Pr#(0)=Max(0,Abs(Int(Pr#(0)))) Pr#(1)=Max(0,Abs(Int(Pr#(1)))) Pr#(2)=Max(0,Abs(Int(Pr#(2)))) Pr#(3)=Max(0,Abs(Int(Pr#(3)))) ' Var$(Pr#(0))=Mid$(Pr$(3),Pr#(1),Pr#(2)) Gosub Vsset(Pr$(0),Mid$(Pr$(3),Pr#(1),Pr#(2))) ' Case "GETL" ! en Gosub Vnset(Chr$(Pr#(0)+64),Len(Pr$(1))) ' Case "STRI" ! ng If Len(Pr$(1))>0 Pr#(0)=Abs(Int(Pr#(0))) If Pr#(0)*Len(Pr$(1))>32000-Len(Binair$(Actb&)) Terr$="Bloc VDT 32K plein" Exit if True Else If Direct! Binair$(Actb&)=Binair$(Actb&)+String$(Pr#(0),Pr$(1)) Else Nextstr$=String$(Pr#(0),Pr$(1)) Endif Endif Endif Case "PAUS" ! e If Pr#(0)*120>32000-Len(Binair$(Actb&)) Terr$="Bloc VDT 32K plein" Exit if True Else If Direct! Binair$(Actb&)=Binair$(Actb&)+String$(Pr#(0)*120,0) Else Nextstr$=String$(Pr#(0)*120,0) Endif Endif ' Case "INC" Gosub Vnset(Pr$(0),@Pr$(0))+1) Case "DEC" Gosub Vnset(Pr$(0),@Vnval(Pr$(0))-1) Case "ADD" Gosub Vnset(Pr$(0),@Vnval(Pr$(0))+Pr#(1)) Case "SUB" Gosub Vnset(Pr$(0),@Vnval(Pr$(0))-Pr#(1)) Case "MUL" Gosub Vnset(Pr$(0),@Vnval(Pr$(0))*Pr#(1)) Case "DIV" If Pr#(1)<>0 ' Var#(Pr#(0))=Div(Var#(Pr#(0)),Pr#(1)) Gosub Vnset(Pr$(0),@Vnval(Pr$(0))/Pr#(1)) Else Terr$="Divison par z‚ro" Exit if True Endif Case "MOD" Gosub Vnset(Pr$(0),Mod(@Vnval(Pr$(0)),Pr#(1))) Case "AND" Gosub Vnset(Pr$(0),And(@Vnval(Pr$(0)),Pr#(1))) Case "OR" Gosub Vnset(Pr$(0),Or(@Vnval(Pr$(0)),Pr#(1))) Case "XOR" Gosub Vnset(Pr$(0),Xor(@Vnval(Pr$(0)),Pr#(1))) Case "NOT" Gosub Vnset(Pr$(0),Not (@Vnval(Pr$(0)))) ' Case "BSET" Gosub Vnset(Pr$(0),Bset(@Vnval(Pr$(0)),Pr#(1))) Case "BCLR" Gosub Vnset(Pr$(0),Bclr(@Vnval(Pr$(0)),Pr#(1))) Case "BCHG" Gosub Vnset(Pr$(0),Bchg(@Vnval(Pr$(0)),Pr#(1))) Case "BTST" Gosub Vnset(Pr$(0),Btst(Pr#(1),Pr#(2))) ' Case "ROR" Gosub Vnset(Pr$(0),Ror(@Vnval(Pr$(0)),Pr#(1))) Case "ROL" Gosub Vnset(Pr$(0),Rol(@Vnval(Pr$(0)),Pr#(1))) ' Case "PRO1" If Direct! Binair$(Actb&)=Binair$(Actb&)+Pro1$ Else Nextstr$=Pro1$ Endif Case "PRO2" If Direct! Binair$(Actb&)=Binair$(Actb&)+Pro2$ Else Nextstr$=Pro2$ Endif Case "PRO3" If Direct! Binair$(Actb&)=Binair$(Actb&)+Pro3$ Else Nextstr$=Pro3$ Endif ' Case "ESC[" ! CSI esc + [ + ... If Direct! Binair$(Actb&)=Binair$(Actb&)+Esc$+"["+Pr$(0) Else Nextstr$=Esc$+"["+Pr$(0) Endif ' Case "ESC" If Direct! Binair$(Actb&)=Binair$(Actb&)+Esc$ Else Nextstr$=Esc$ Endif Case "SEP" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(19) Else Nextstr$=Chr$(19) Endif Case "SOH" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(1) Else Nextstr$=Chr$(1) Endif Case "STX" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(2) Else Nextstr$=Chr$(2) Endif Case "ETX" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(3) Else Nextstr$=Chr$(3) Endif Case "EOT" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(4) Else Nextstr$=Chr$(4) Endif Case "ENQ" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(5) Else Nextstr$=Chr$(5) Endif Case "ACK" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(6) Else Nextstr$=Chr$(6) Endif Case "DLE" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(16) Else Nextstr$=Chr$(16) Endif Case "NAK" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(21) Else Nextstr$=Chr$(21) Endif Case "SYN" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(22) Else Nextstr$=Chr$(22) Endif Case "ETB" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(23) Else Nextstr$=Chr$(23) Endif Case "EM" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(25) Else Nextstr$=Chr$(25) Endif Case "CSUB" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(26) Else Nextstr$=Chr$(26) Endif Case "FS" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(28) Else Nextstr$=Chr$(28) Endif Case "GS" If Direct! Binair$(Actb&)=Binair$(Actb&)+Chr$(29) Else Nextstr$=Chr$(29) Endif ' Case "D.HA" ! DOUBLE.HAUTEUR If Direct! Binair$(Actb&)=Binair$(Actb&)+Dh$ Else Nextstr$=Dh$ Endif Case "D.LA" ! DOUBLE.LARGEUR If Direct! Binair$(Actb&)=Binair$(Actb&)+Dl$ Else Nextstr$=Dl$ Endif Case "D.TA" ! DOUBLE.TAILLE If Direct! Binair$(Actb&)=Binair$(Actb&)+Dt$ Else Nextstr$=Dt$ Endif Case "TAIL" ! TAILLE.NORMALE If Mid$(E$,8,4)="NORM" If Direct! Binair$(Actb&)=Binair$(Actb&)+Tn$ Else Nextstr$=Tn$ Endif Endif ' Case "TRAN" ! Prochaine instr transparente Tr%=1 Case "FORG" ! Oublier x instructions suivantes Tr%=Int(Pr#(0)) Case "TRDA" ! Oublier x octets If Direct! Binair$(Actb&)=Binair$(Actb&)+@Transp$(Int(Pr#(0))) Else Nextstr$=@Transp$(Int(Pr#(0))) Endif ' Case "STBL" ! ock If Star!=False Star!=True Else Terr$="Block d‚j… d‚fini" Exit if True Endif ' Case "STOR" ! eblock If Star! ' Var$(Pr#(0))="" @Vsset(Pr$(0),Star$) Clr Star$ ' Swap Var$(Pr#(0)),Star$ Clr Star$,Star! Else Terr$="Block non d‚fini" Exit if True Endif ' Case "OPTB" ! '97 ock $S% Select Mid$(E$,5,2) ! 2 suivants Case "IN" If @Opti<>0 Terr$="ProblŠmes lors de l'optimisation" Exit if True Endif Case "LO" X&=Actb& Actb&=6 Binair$(6)=@Vsval$(Pr$(0)) If @Opti=0 @Vsset(Pr$(0),Binair$(6)) Else Terr$="ProblŠmes lors de l'optimisation" Exit if True Endif Actb&=X& Endselect ' Case "ELSE" ! ELSE , sauter X&=1 ! rejoindre 1 Endif Y&=A&+1 Do Select Left$(Page$(Y&),4) Case "ENDI" Dec X& Default Select Left$(Page$(Y&),2) Case "IF" Inc X& Endselect Endselect Inc Y& Loop until X&=0 Or (Y&>Maxty&-1) If (Y&>Maxty&-1) Terr$="If sans endifs" Exit if True Endif A&=Y&-1 ' Case "PROC" ! PROC , sauter Dec H% ' X&=1 ! rejoindre 1 RETURN Y&=A&+1 Do Select Left$(Page$(Y&),4) Case "RETU" X&=0 Endselect Inc Y& Loop until X&=0 Or (Y&>Maxty&-1) If X&<>0 Terr$=">"+"PROCEDURE"+" sans RETURN" Exit if True Endif A&=Y&-1 ' Case "REDO" Reds%=A&+1 Redo%=Int(Pr#(0)) If Redo%=0 Reds%=0 Redo%=0 Else if Redo%<0 Terr$="REDO offset n‚gatif" Exit if True Endif ' Case "RETU" ! rn Dec H% ' If Len(Xproc$)>0 A&=Cvi(Left$(Xproc$,2)) ! plus un Xproc$=Mid$(Xproc$,3) ' Retrouver params localX/localS For X&=0 To 9 Procx#(X&)=0 Proc$(X&)="" Next X& For X&=9 Downto 0 ' Y&=Cvi(Left$(Propar$,2)) Propar$=Mid$(Propar$,3) ' Proc$(X&)=Left$(Propar$,Y&) Propar$=Mid$(Propar$,Y&+1) ' Procx#(X&)=Cvd(Left$(Propar$,8)) Propar$=Mid$(Propar$,9) ' Next X& ' Else Terr$=">RETURN sans "+"PROCEDURE" Exit if True Endif ' Case "REPL" If Direct! Binair$(Actb&)=Binair$(Actb&)+@Repet$(Int(Pr#(0))) Else Nextstr$=@Repet$(Int(Pr#(0))) Endif Case "REPE" ' Select Mid$(E$,5,2) ' Case "TE" ' ' Case "AT" Inc Prodo% ! profondeur +1 ' Stav$(Stav%)="_DO"+Str$(Prodo%) Inc Stav% ' Mid$(Stan$,Stan%)=Mkd$(1) ! stack end Add Stan%,8 ' Mid$(Stas$,Stas%)=Mkd$(1) ! stack step (1 normal) Add Stas%,8 ' Mid$(Stal$,Stal%)=Mki$(A&+1) ! line Add Stal%,2 ' Mid$(Stat$,Stat%)=Chr$(-2) ! boucle repeat Inc Stat% ' @Vnset(Stav$(Stav%-1),0) ! index ' ' Endselect ! repeat ou repete? ' Case "DO" Inc Prodo% ! profondeur +1 ' ' If Prodo%>14 ! trop profond! ' Terr$="Stack error, DO trop profond" ' Exit if True ' Else ' Mid$(Stav$,Stav%)=Chr$(Prodo%) ! stack var ' Stav$(Stav%)="_DO"+Str$(Prodo%) Inc Stav% ' Mid$(Stan$,Stan%)=Mkd$(Pr#(0)) ! stack end Add Stan%,8 ' Mid$(Stas$,Stas%)=Mkd$(1) ! stack step (1 normal) Add Stas%,8 ' Mid$(Stal$,Stal%)=Mki$(A&+1) ! line Add Stal%,2 ' Mid$(Stat$,Stat%)=Chr$(-1) ! boucle Do Inc Stat% ' @Vnset(Stav$(Stav%-1),1) ! index ' Dovar#(Prodo%)=1 ' Endif ' Case "FOR" ' If Pr#(2)-Pr#(1)<>0 ! for non nul ' ' Mid$(Stav$,Stav%)=Pr$(0) Stav$(Stav%)=Pr$(0) ! stack var Inc Stav% ' Mid$(Stan$,Stan%)=Mkd$(Pr#(2)) ! stack end Add Stan%,8 ' If Sgn(Pr#(2)-Pr#(1))<>0 Mid$(Stas$,Stas%)=Mkd$(Sgn(Pr#(2)-Pr#(1))) ! stack step Else Mid$(Stas$,Stas%)=Mkd$(1) ! 1 boucle Endif Add Stas%,8 ' Mid$(Stal$,Stal%)=Mki$(A&+1) ! line Add Stal%,2 ' Mid$(Stat$,Stat%)=Chr$(0) ! boucle Do Inc Stat% ' ' Endif ' Var#(Pr#(0))=Pr#(1) ! index Gosub Vnset(Pr$(0),Pr#(1)) ' Case "FORS" If Pr#(3)<>0 If Sgn(Pr#(2)-Pr#(1))<>Sgn(Pr#(3)) And Pr#(2)-Pr#(1)<>0 Terr$="Boucle non analysable, donn‚es contradictoires" Exit if True Else ' ' Mid$(Stav$,Stav%)=Pr$(0) ! stack var Stav$(Stav%)=Pr$(0) Inc Stav% ' Mid$(Stan$,Stan%)=Mkd$(Pr#(2)) ! stack end Add Stan%,8 ' Mid$(Stas$,Stas%)=Mkd$(Pr#(3)) ! stack step Add Stas%,8 ' Mid$(Stal$,Stal%)=Mki$(A&+1) ! line Add Stal%,2 ' Mid$(Stat$,Stat%)=Chr$(0) ! boucle Do Inc Stat% ' ' Var#(Pr#(0))=Pr#(1) ! index Gosub Vnset(Pr$(0),Pr#(1)) Endif Else Terr$="Boucle sans fin, step nul" Exit if True Endif ' ' Case "UNTI" ! until cond ' Dec H% If Stav%-1+Stas%-1+Stan%-1+Stal%-1>0 ' (pas de vnset) Select Word(&HFF00+Asc(Mid$(Stat$,Stat%-1,1))) Case -2 ! Repeat Default Terr$="Erreur Until avec For" Exit if True Endselect ' If Pr#(0) ! cond remplie Dec Prodo% ! profondeur -1 Sub Stav%,1 Sub Stan%,8 Sub Stas%,8 Sub Stal%,2 Sub Stat%,1 Else A&=Cvi(Mid$(Stal$,Stal%-2,2))-1 Endif ' Else Terr$="REP=ProblŠmes internes dans la structure" Exit if True Endif ! de test length ' Case "NEXT" ! nexts ' Dec H% If Stav%-1+Stas%-1+Stan%-1+Stal%-1>0 ' X&=Asc(Mid$(Stav$,Stav%-1,1)) Resultat#=Cvd(Mid$(Stas$,Stas%-8,8)) ' Var#(X&)=Var#(X&)+Resultat# Gosub Vnset(Stav$(Stav%-1),@Vnval(Stav$(Stav%-1))+Resultat#) ' Select Word(&HFF00+Asc(Mid$(Stat$,Stat%-1,1))) Case -2 Terr$="Erreur Next avec Repeat" Exit if True Endselect ' If Sgn(Resultat#)=1 ' If Var#(X&)>Cvd(Mid$(Stan$,Stan%-8,8)) ! fin for If @Vnval(Stav$(Stav%-1))>Cvd(Mid$(Stan$,Stan%-8,8)) ! fin for ' If Word(&HFF00+Asc(Mid$(Stat$,Stat%-1,1)))=-1 Dec Prodo% Endif ' ' Stav$=Left$(Stav$,Len(Stav$)-1) Sub Stav%,1 ' ' Stan$=Left$(Stan$,Len(Stan$)-8) Sub Stan%,8 ' ' Stas$=Left$(Stas$,Len(Stas$)-8) Sub Stas%,8 ' ' Stal$=Left$(Stal$,Len(Stal$)-2) Sub Stal%,2 ' ' Stat$=Left$(Stat$,Len(Stat$)-1) Sub Stat%,1 ' Else ' -1 car inc A&=Cvi(Mid$(Stal$,Stal%-2,2))-1 Endif ' Else ' If Var#(X&)0 Terr$=B$ Endif ' Var#(Y&)=Resultat# @Vnset(Pr$(0),Resultat#) Default B$=@Rinput$("Entr‚e, chaine:","") ' Var$(Y&)=B$ @Vsset(Pr$(0),B$) ' Endselect Clr B$ Exit if Len(Terr$)=0 Loop If Not Set_multi! ~@Wind_update01(1) Endif W2%=Timer ' Case "FAIL" Terr$="# "+Left$(Pr$(0),Min(Len(Pr$(0)),40)) Exit if True ' Case "CLEA" ! rbin Binair$(Actb&)="" Clr Nextstr$ Void Fre(0) Gosub Comp.info("C","Bloc VDT effac‚") Case "SAVE" ! bin ' If Set_multi! ' @Top(1) ' @Rdw_all(1) ' Endif File$(2)=Upper$(Trim$(Pr$(0))) If Len(Binair$(Actb&))>0 If Len(File$(2))>0 File$(2)=Ã+File$(2) Endif Gosub Comp.info("C","SaveBin: s‚lection") Add W%,(Timer-W2%) ~@Wind_update01(0) File$(2)=Upper$(Trim$(File$(2))) @Save.vdt If Not Set_multi! ~@Wind_update01(1) Endif W2%=Timer Else If Len(File$(2))>0 Fileh&=@Fcreate(File$(2),0) If @Tsterr(Fileh&) ~@Tsterr(@Fclose(Fileh&)) Endif Else Terr$="Nom de fichier vide, bloc vide.." Exit if True Endif Endif ' Case "FCRE" ! ate '97 File$(2)=Upper$(Trim$(Pr$(0))) If Len(File$(2))>0 Fileh&=@Fcreate(File$(2),0) If @Tsterr(Fileh&) ~@Tsterr(@Fclose(Fileh&)) Endif Else Terr$="Nom de fichier vide" Exit if True Endif Case "FDEL" ! ete '97 File$(2)=Upper$(Trim$(Pr$(0))) If Len(File$(2))>0 If @Exist(File$(2)) ~@Tsterr(@Fdelete(File$(2))) Endif Else Terr$="Nom de fichier vide" Exit if True Endif ' Case "ADDB" ! in,lock Select Mid$(E$,5,2) ! 2 suivants Case "IN" File$(2)=Upper$(Trim$(Pr$(0))) If Len(File$(2))>0 Add W%,(Timer-W2%) File$(2)=Upper$(Trim$(File$(2))) ' Fileh&=@Fopen(File$(2),2) If @Tsterr(Fileh&) If @Tsterr(@Fendseek(Fileh&,0)) ~@Tsterr(@Fadrwrite(Fileh&,V:Binair$(Actb&),Len(Binair$(Actb&)))) Endif ~@Fclose(Fileh&) Else Terr$="Erreur AddBin" Exit if True Endif ' W2%=Timer Endif ' Case "LO" ! ck File$(2)=Upper$(Trim$(Pr$(1))) If Len(File$(2))>0 Add W%,(Timer-W2%) File$(2)=Upper$(Trim$(File$(2))) ' If Not @Exist(File$(2)) Fileh&=@Fcreate(File$(2),0) ~@Fclose(Fileh&) Endif ' Fileh&=@Fopen(File$(2),2) If @Tsterr(Fileh&) If @Tsterr(@Fendseek(Fileh&,0)) ~@Tsterr(@Fadrwrite(Fileh&,V:Pr$(0),Len(Pr$(0)))) Endif ~@Fclose(Fileh&) Else Terr$="Erreur AddBlk" Exit if True Endif ' W2%=Timer Endif Endselect ' Case "PHOT" ! o '97 Clr Ptg$ Ptg$=@Jpg2vdt$(Pr$(0),Pr#(1),Pr#(2),Pr#(3),Pr#(4)) If Len(Ptg$)=0 Terr$="Erreur lors de PHOTO - PhotoGen, V:A" Exit if True Endif If Direct! If Len(Binair$(Actb&))+Len(Ptg$)<32000 Binair$(Actb&)=Binair$(Actb&)+Ptg$ Else Terr$="Bloc 32K plein" Exit if True Endif Else Nextstr$=Ptg$ Endif ' ' Case "DISP" Add W%,(Timer-W2%) Gosub Defmouse(3) ' Gosub Comp.info("C",": "+Left$(Pr$(0),Min(Len(Pr$(0)),$ And And And And Eqv Eqv ))+" ?") ' @Beep ' ~@Mul_evnt_keybd ' @Videkbd ' W2%=Timer Case "QDIS" ! play sans inp ' Gosub Defmouse( 3 Gosub Menu.info(": "+Left$(Pr$(0),Min(Len(Pr$(0)),40))) ' Gosub Defmouse( 2 Case "SHOW" @Rshow("Message:",Left$(Pr$(0),Min(Len(Pr$(0)),64))) ' Case "INFO" If Pr#(0) Aff!=True @Infoc Else Aff!=False ' Gosub Menu.info(": ") Endif ' Case "ASKE" ! y Add W%,(Timer-W2%) Gosub Defmouse(3) ' @Beep ' Var#(Pr#(0))=@Mul_evnt_keybd @Vnset(Pr$(0),@ ' D‚coder 2 octets->1 octet ' Var#(Pr#(0))=@Geminp(Var#(Pr#(0))) @Vnset(Pr$(0),@Geminp(@Vnval(Pr$(0)))) @Videkbd ' W2%=Timer Case "QASK" ! sans beep Add W%,(Timer-W2%) ' Gosub Defmouse( 3 ' If Btst(Evnt_multi(&X100001,0,0,0,0,0,0,0,0,0,0,0,0,0,0,10,X&,X&,X&,X&,Y&,X&),0) ' D‚coder 2 octets->1 octet ' Var#(Pr#(0))=@Geminp(Var#(Pr#(0))) @Vnset(Pr$(0),@Geminp(Y&)) Else ' Var#(Pr#(0))=0 @Vnset(Pr$(0),0) Endif @Videkbd ' ' Gosub Defmouse( 2 W2%=Timer Case "OPT" If Pr#(0)=True ! OPT ON Opt!=True Else Opt!=False Endif ' Case "END" ! Fin @Infoc Exit if True ' Case "SWEE" ! TEL!! haha le gag... If Pr#(0)=True Void Fre(0) ~Xbios(32,L:Swsound%) Else Beep Endif Case "GAG" ! AHRGGH If Pr#(0)=True Out 4,15 Else Out 4,16 Endif ' Default ' Dec H% ' ENDIF par ex Endselect ! de left$(e$,4) ' If Set_critical! ! ‚tat critique? If Fre()-Lowlimit%<=Len(Nextstr$)*2 Terr$="M‚moire pleine" Exit if True Endif Endif ' ' Conditions NON optimales? ' If (Redo%+Mask%+EveRy&+Tr%=0) And (Not Star!) And (Flag!) And (Not Autosend!) If Not Direct! ! on a besoin de traiter nextstr$... ' If Len(Nextstr$)>0 If Tr%>0 Or Mask%>0 Or Every&>0 If Left$(E$,3)="TXT" If Tr%>0 Tr%=Max(0,Int(Tr%-1)) Nextstr$=@Transp$(Len(Nextstr$))+Nextstr$ Endif ' If Mask%>0 Mask%=Max(0,Int(Mask%-1)) If Flag! ! not ascii Nextstr$=Mask$+Nextstr$ Endif Endif ' If Every&>0 Every&=Max(0,Int(Every&-1)) If Flag! Nextstr$=Every$+Nextstr$ Endif Endif Endif Endif Endif ' If Redo%>0 If Len(Nextstr$)>0 If Ityp|=0 Or Ityp|=6 ' If A&=Reds% If Redo%*Len(Nextstr$)>32000-Len(Binair$(Actb&)) Terr$="Bloc VDT 32K plein" Exit if True Else Nextstr$=String$(Redo%,Nextstr$) Redo%=0 Endif ' Endif Else Terr$="REDO impossible ici" Exit if True Endif Else If Ityp|<>2 If Not (Ityp|=1 And Reds%=A&+1) Terr$="REDO impossible ici" Endif Endif Endif Endif ' If Flag!=False ! Ascii seulement If Len(Binair$(Actb&))+Len(Nextstr$)<32000 ' Select Left$(E$,3) ' Case "TXT" Cr&=False For X&=1 To Len(Nextstr$) Y&=Asc(Mid$(Nextstr$,X&,1)) Select Y& Case 10,13,32 To If Star!=False Binair$(Actb&)=Binair$(Actb&)+Chr$(Y&) Else Star$=Star$+Chr$(Y&) Endif Default If Star!=False Binair$(Actb&)=Binair$(Actb&)+Chr$(32) Else Star$=Star$+Chr$(32) Endif Endselect Next X& Chr_asc!=True ! txt pass‚, cr possible Case "CR","CRT","CR2" Cr&=True If Star!=False Binair$(Actb&)=Binair$(Actb&)+Cr$ Else Star$=Star$+Cr$ Endif Chr_asc!=False ! cr d‚j… ok Default If Chr_asc! ! ligne ascii en cours Binair$(Actb&)=Binair$(Actb&)+Cr$ Chr_asc!=False ! cr ok Else ! chr sp‚cial Binair$(Actb&)=Binair$(Actb&)+Chr$(32) Endif ' Endselect ' Else Terr$="Bloc VDT 32K plein" Exit if True Endif ' Else ' If Star!=False Binair$(Actb&)=Binair$(Actb&)+Nextstr$ If Autosend! Add W%,(Timer-W2%) Send(Nextstr$) W2%=Timer Endif Else Star$=Star$+Nextstr$ Endif Endif ' Endif ! traiter next str$? ' Endselect ! de if SELECT left$(e$,2)="IF" ' If Len(Binair$(Actb&))=>32000 Terr$="Bloc VDT 32K plein" Exit if True Endif ' Endif ! if assignation or instruct (ou proc) Endif ! if len.. etc ' If Mod(Count%,4)=0 ! 1 sur 4 If @Shiftbrk2 If Set_multi! If @Firstw<>-1 H%=-1 Endif Else H%=-1 Endif Endif Endif ' ' ******* Inc A& ! Pointeur! ' ******* ' If Set_multi! Add W%,(Timer-W2%) ' If Mod(Count%,Set_mtime%)=0 ' If Mod(Count%,8)=0 If Timer-Tm%>Set_mtime%*10 Tm%=Timer ! noter!! ' ' If @Timing ! timer ok? Repeat Evnmnt&=Evnt_multi(&X110001,0,0,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),0) If Evnmnt&<>&X100000 ! message/clavier If Btst(Evnmnt&,4) ! messag Reponse%=@Wmanage(True) ! True: tout g‚rer If Reponse%=-1 ! au secour!!!! H%=True Set_end!=True Else Select Reponse% Case 0 Case 10 ! stop Void Menu_tnormal(Menu_adr%,Wmenu&(3),1) Select @Form_alert(2,"[3][|Le menu est bloqu‚ pendant |la compilation!! |][ Stopper | Infos | D'accord ]") Case 1 If @Form_alert(1,"[3][|Stopper la compilation? |][Confirmer| Annuler ]")=1 H%=True ! break Endif Case 2 ! infos ~@Form_alert(1,"[0][Infos:|Lignes compil‚es: "+Str$(H%)+" |Position: "+Str$(A&)+" sur "+Str$(Maxty&-1)+" lignes ("+Str$(Round((A&/(Maxty&-1))*100,1))+"%)|en "+Str$(Len(Binair$(Actb&)))+" octets][ Bien. ]") Endselect Default Endselect Endif ' Else if Btst(Evnmnt&,0) ! keybd @Beep ! on en veut pas Endif ! which event? Endif ! if event Until Evnmnt&=&X100000 ! message ok (timer=fin) Endif ! if evnt timing is ok W2%=Timer Endif ! if multi ' Endif ' ' ---------------------------------------- Loop until (A&=>Maxty&-1) Or (H%=True) @Infoc ' ---------------------------------------- ' ' R‚sultat dans Binair$(Actb) ' ~@Wind_update01(0) ' Clr E$,A$,B$,T$,Stan$,Stav$,Stal$,Stas$,Stat$ Clr Xproc$,Propar$ Erase Pr#(),Pr$() ' a r‚serv‚ For X&=0 To 9 Proc$(X&)="" Procx#(X&)=0 Next X& Void Fre(0) Gosub Defmouse(0) ' If Set_end! Gosub Defmouse(2) Binair$(Actb&)="" Terr$="Le systŠme a ‚t‚ ferm‚!! "+Str$(A&) Gosub Menu.info("Ferm‚!! * L:"+Str$(A&)) Set_system&=0 Gosub Defmouse(0) B&=-3 Gosub Help(0,B&) Return 0 Endif ' Set_system&=0 ! tout g‚rer maintenant ' Gosub hide_menu(1) ! d‚cacher menu ' If H%<>-1 If Len(Terr$)>0 Binair$(Actb&)="" Terr$=Terr$+" * L:"+Str$(A&) ' If @Wind_open(0)=>0 T$=Page$(Ty&) ~@Do_winput(Page_id&,-1,-1,-2,Maxstr&,T$) Do_wkill(Page_id&) Ty&=Max(0,Min(Maxty&-2,A&)) T$=Page$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,T$) Clr T$ Else Gosub Menu.info("Erreur fenˆtre non accessible") Endif ' Return -1 Else If Set_multi!=False If B&=0 Gosub Comm.info("C",Str$(H%)+" lignes compil‚es en "+Str$(Round(W%/200,2))+" s., "+Str$(Len(Binair$(Actb&)))+" octets.") Else Gosub Comm.info("C",Str$(H%)+" lignes compil‚es en "+Str$(Round(W%/200,2))+" s.,"+", "+Str$(Len(Binair$(Actb&)))+" octets."+" Opt: "+Str$(B&)+" octets") Endif Return 0 Else ! 'multi' If B&=0 Gosub Comm.info("C",Str$(H%)+" lignes compil‚es en "+Str$(Round(W%/200,2))+" s. {Multi}, "+Str$(Len(Binair$(Actb&)))+" octets.") Else Gosub Comm.info("C",Str$(H%)+" linges compil‚es en "+Str$(Round(W%/200,2))+" s. {Multi}, "+Str$(Len(Binair$(Actb&)))+" octets."+" Opt: "+Str$(B&)+" octets") Endif ' @Top(1) Return 0 Endif Endif ' Else ' Binair$(Actb&)="" Gosub Comm.info("C","*Interruption. * L:"+Str$(A&)) Return 0 Endif ' Else If Len(Terr$)=0 If C&=-1 Terr$="RETURN sans "+"PROCEDURE" Else if C&=-2 Terr$="PROCEDURE"+" dans une structure" Else if C&=-3 Terr$="PROCEDURE"+" d‚j… d‚finie" Else if C&=-4 Terr$="nom de "+"PROCEDURE"+" impossible" Else if C&=1 Terr$="PROCEDURE"+" sans RETURN" Else Terr$="PROCEDURE"+" dans une PROCEDURE" Endif Endif Endif ' Set_system&=0 ! tout g‚rer maintenant ' Gosub hide_menu(1) ! d‚cacher menu ~@Wind_update01(0) ' Terr$=Terr$+" * L:"+Str$(A&) If @Wind_open(0)=>0 T$=Page$(Ty&) ~@Do_winput(Page_id&,-1,-1,-2,Maxstr&,T$) Do_wkill(Page_id&) Ty&=Max(0,Min(Maxty&-2,A&)) T$=Page$(Ty&) ~@Do_winput(Page_id&,Ccsizex&+Pag_ind&(Ty&)*Ccsizex&,Ccsizey&+Ccsizey&*Ty&,&H0,Maxstr&,T$) Clr T$ Gosub Defmouse(0) ~@Wind_update01(0) Else Gosub Menu.info("Erreur fenˆtre non accessible") Endif Return -1 ' Else If X&>0 Terr$="For sans next" Else Terr$="Next sans for" Endif Gosub Defmouse(0) Set_system&=0 ! tout g‚rer maintenant ' Gosub hide_menu(1) ! d‚cacher menu ~@Wind_update01(0) Return -1 Endif Else If Y&=True Terr$="Endifs sans If" Else if Y&=-2 Terr$="Else sans If" Else Terr$="If sans endifs" Endif Gosub Defmouse(0) ' Gosub hide_menu(1) ! d‚cacher menu Set_system&=0 ! tout g‚rer maintenant ~@Wind_update01(0) Return -1 Endif Else Gosub Menu.info("Erreur fenˆtre non accessible") Endif ' Else Terr$="M‚moire pleine" Set_system&=0 Return True Endif ' ' ' Gosub hide_menu(1) ! d‚cacher menu Set_system&=0 ! tout g‚rer maintenant Terr$="ProblŠmes internes" Return -1 Endfunc ' Procedure Comp.info(A$,E$) ' If Len(A$)=1 $S& Select A$ Case "M" A$="Menu" Case "C" A$="Compiler" Case "G" A$="G‚n‚ral" Case "B" A$="Bitmap" Case "E" A$="Emulateur" Endselect $S% Endif ' If Left$(E$,1)="*" Insert Compinf$(0)=E$+Space$(Max(1,61-Len(E$)))+A$+Space$(Max(1,20-Len(A$)))+Time$ If Len(E$)>0 @Menu.info(Mid$(E$,2)) Endif Else Insert Compinf$(0)=E$+Space$(Max(1,60-Len(E$)))+A$+Space$(Max(1,$ And And And And Eqv Imp -Len(A$)))+Time$ If Len(E$)>0 @Menu.info(E$) Endif Endif Rdw_all(1) ' Return ' Procedure Comp.rst Local A& For A&=0 To Compi& Compinf$(A&)="" Next A& Rdw_all(1) Return ' ' Provenance (M,G,C,autre), [*]Message Procedure Comm.info(A$,E$) Comp.info(A$,E$) $S& Select Left$(E$,1) Case "*" Menu.info(Mid$(E$,2)) Default Menu.info(E$) Endselect $S% Return ' Function Mul_evnt_keybd $F% Local A& ' Gosub Defmouse(3) ~@Wind_update01(1) If Set_multi! @Top(1) @Rdw_all(1) Endif A&=Evnt_keybd() If Set_multi! Gosub Defmouse(0) ~@Wind_update01(0) Else Gosub Defmouse(2) Endif ' Return A& Endfunc ' ' Inventaire des procedures courantes Procedure Plock Local A&,C& Local B$,T$ ' Clr C& Clr Proc$ For A&=0 To Maxty&-1 ' T$=Left$(Page$(A&),4)+Chr$(32) $S% Select Left$(Page$(A&),4) ' Case "PROC" Inc C& ' PROCEDURE truc T$=Mid$(Page$(A&),11) ! id If @Test9(T$) B$=T$ ' ' 2 octets=pos, "@"+x octets=nom+params, 2 octets= barriŠres (instr) ' B$=Mid$(Trim$(Upper$(B$)),1,255) B$=Trim$(Upper$(B$)) ! inutile If Instr(B$,"(")<>0 B$=Left$(B$,Instr(B$,"(")-1)+"+"+Mid$(B$,Instr(B$,"(")) Else B$=B$+"+" Endif ' If Len(B$)<>0 ! "" If Instr(Proc$,Chr$(32)+"@"+B$)=0 For D%=1 To Len(B$) Select Asc(Mid$(B$,D%,1)) Case 0 To 31 C&=-4 Endselect Next D% ' If C&>0 ' position= 2 premiers octets Proc$=Proc$+Mki$(A&)+Chr$(32)+"@"+B$+Chr$(32) Endif Endif Endif Endif ' Clr B$ Endselect Next A& Return ' ' Proc e$ ‚xiste? Function Pproc(E$) $F% $S& Local X&,A&,N& Local A$,T$ ' ' X&=Instr(Proc$,Chr$(32)+"@"+E$+"+") If X&>0 Sub X&,2 A&=Cvi(Mid$(Proc$,X&,2)) ! plus 1 Instr$(Istr&,0)=E$ ' ' .. BOX( ) .. Add X&,3 Clr E$ While Mid$(Proc$,X&,1)<>Chr$(32) E$=E$+Mid$(Proc$,X&,1) Inc X& Wend ' E$=Mid$(Proc$,X&+3,Instr(Proc$,Chr$(32),X&+3)-X&-3) X&=Instr(E$,"(") If X&<>0 If Instr(E$,")")<>0 A$=Mid$(E$,X&+1,Instr(E$,")")-X&-1) E$=Left$(E$,X&-1) Endif ' Else A$="" Endif ' For X&=0 To Dinstr& Instr&(Istr&,X&)=0 Next X& ' If Len(A$)>0 X&=1 N&=0 Do ' If Mid$(A$,X&+1,1)="," Or X&+1=>Len(A$) ' Case ",","" Clr T$ Do T$=T$+Mid$(A$,X&,1) Inc X& Loop until Mid$(A$,X&,1)="," Or X&>Len(A$) If Mid$(A$,X&,1)="," Inc X& Endif ' ' paramx: 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc $S& Select Left$(T$,2) ' Case "ON","/" Instr&(Istr&,N&)=1 Inc N& Case "OC","&" Instr&(Istr&,N&)=2 Inc N& Case "RE","#" Instr&(Istr&,N&)=3 Inc N& Case "CH","$" Instr&(Istr&,N&)=4 Inc N& Case "~" ! INTERNE Instr&(Istr&,N&)=5 Inc N& Case "*" ! INTERNE Instr&(Istr&,N&)=6 Inc N& Case "CO","œ" Instr&(Istr&,N&)=7 Inc N& Case "N6","." Instr&(Istr&,N&)=8 Inc N& Default A&=-1 Exit if True Endselect $S% ' ' Else ' ' Default ' Terr$="@ "+"Erreur"+" de syntaxe"+" aprŠs params" ' A&=-1 ' Exit if True ' ' Endselect ' Endif ' Add X&,2 Loop until X&>Len(A$) Endif ' Else A&=-1 ! introuvable Endif ' Return A& ' $S% Endfunc ' Function Decompile $F% $S% Local A& Local Flag! Local T& ' Local A&,B%,C%,D%,E%,F% ' d‚comp /\: Local H%,N%,X%,Y%,Z%,Reponse%,Maxl& Local A! ! flag tel drcs Local T$ ' Clr Terr$,Terrp&,T$ Edited!(0)=True @Top(0) @Test_menu ' @Menu_set Reponse%=0 ' ~@Wind_open(1) ~@Wind_update01(1) ' ' If Wopen!(1) ' If Len(Binair$(Actb&))=0 For A&=0 To 5 If Len(Binair$(A&))>0 Actb&=A& Exit if True Endif Next A& Endif Sel_pop(Adr%(40),Des_blk&,Actb&+1) Exdo!=True Do A&=Byte(@Form_wdo(40,0)) Ob_state(Adr%(40),A&)=Bclr(Ob_state(Adr%(40),A&),0) ~@Form_wdo(40,-3) Select A& Case Des_ok& Actb&=@State_pop(Adr%(40),Des_blk&)-1 If Len(Binair$(Actb&))=0 A&=-1 Endif Default Endselect Loop until A&<>-1 ' If A&=Des_ok& ' Flag!=Btst(Ob_state(Adr%(40),Des_2&),0) Flag!=(@State_pop(Adr%(40),Des_1&)=2) ' If Btst(Ob_state(Adr%(40),Des_r&),0) ! replace ' T&=0 ' Else if Btst(Ob_state(Adr%(40),Des_a&),0) ! add ' T&=1 ' Else if Btst(Ob_state(Adr%(40),Des_i&),0) ! ins ' T&=2 ' Endif T&=@State_pop(Adr%(40),Des_r&)-1 ' Gosub Defmouse(2) @Clr_eb If T&=0 Ty&=0 Maxl&=0 Erase Page$(),Pag_adr%(),Pag_len&(),Pag_ind&() Clr Proc$ Clr Vid$ Edited!(0)=True @Test_menu ' @Menu_set Do_wkill(0) Gosub Page_manage(0) Else Do_wkill(0) Endif ~@Wind_update01(1) Gosub Menu.info("DeCompiler - [SHIFT]-[SHIFT] pour interrompre.") ' Select T& Case 0 ' Actb&=0 ???????? A&=0 ! Ligne Case 1 A&=Maxty& ! Ligne If Len(Page$(A&))=0 A&=Max(0,A&-1) Endif Case 2 A&=Ty& ! Ligne If Len(Page$(A&))>0 Insert Page$(A&)="" Endif Endselect Ty&=0 ' X%=1 ! Char Redo!=False ! repetition d'instructions Vtran%=0 Vtranx%=0 Vtranpos%=0 Maxl&=Len(Binair$(Actb&)) Clr N% ! nb de tours (mem verify) Do Inc N% ! hop 1 tour ' B%=Asc(Mid$(Binair$(Actb&),X%,1)) Select B% Case 32 To 255 ' If Len(T$)=0 T$="TXT "+Quote$ Endif If Chr$(B%)=Quote$ T$=T$+Quof$+Quote$ Else if Chr$(B%)=Quof$ T$=T$+Quof$+Quof$ Else T$=T$+Chr$(B%) Endif ' If Len(T$)>86 T$=T$+Quote$ Page$(A&)=T$ Add_dc Clr T$ Endif ' Default ' If Len(T$)>0 T$=T$+Quote$ Page$(A&)=T$ Add_dc Clr T$ Endif ' Select B% ' Case 27 ! ESC! ' Inc X% ! ON SAUTE, C%=Asc(Mid$(Binair$(Actb&),X%,1)) D%=Asc(Mid$(Binair$(Actb&),X%+1,1)) E%=Asc(Mid$(Binair$(Actb&),X%+2,1)) F%=Asc(Mid$(Binair$(Actb&),X%+3,1)) Select C% ' Case "(" Select D% Case 32 Select E% Case "B" Page$(A&)="DRCTXT ON" Add_dc Add X%,2 Default Page$(A&)="ESC" Add_dc Dec X% Endselect Case "@" Page$(A&)="DRCTXT OFF" Add_dc Inc X% Default Page$(A&)="ESC" Add_dc Dec X% Endselect Case ")" Select D% Case 32 Select E% Case "C" Page$(A&)="DRCGRF ON" Add_dc Add X%,2 Default Page$(A&)="ESC" Add_dc Dec X% Endselect Case "c" Page$(A&)="DRCGRF OFF" Add_dc Inc X% Default Page$(A&)="ESC" Add_dc Dec X% Endselect Case "9" ! PRO1 ' k‚sako? on ne devrait en fait pas recevoir du pro1, mais ' sait on jamais? Select D% ' Case 127 Page$(A&)="RESET" Inc X% ' Add X%,2 Add_dc ' Default Page$(A&)="PRO1" Add_dc ' Inc X% ' Endselect ' Case ":" ! PRO2 ' k‚sako? on ne devrait en fait jamais recevoir du pro2, mais ' sait on jamais??? ' Select D% ' Case "f" ! Transparence? (Gorbi!!) Vtranx%=E% Page$(A&)="TRDATA "+Str$(E%) Add X%,2 Add_dc Vtran%=X% ! verify Vtranpos%=A& ' Inc X% ' Case "i" Select E% ' Case "C" ! rouleau on Page$(A&)="ROULEAU ON" Add_dc Add X%,2 Case "E" Page$(A&)="MIN" Add_dc Add X%,2 Default Page$(A&)="PRO2" Add_dc Endselect Case "j" Select E% ' Case "C" ! rouleau off Page$(A&)="ROULEAU OFF" Add_dc Add X%,2 Case "E" Page$(A&)="MAJ" Add_dc Add X%,2 ' ' Default Page$(A&)="PRO2" Add_dc Endselect ' Case "1" Select E% ' Case 125 ! a80c Page$(A&)="A80COL" Add_dc Add X%,2 ' Default Page$(A&)="PRO2" Add_dc Endselect ' Case "2" Select E% ' Case 125 ! f80c Page$(A&)="F80COL" Add_dc Add X%,2 ' Case 126 ! 40c Page$(A&)="40COL" Add_dc Add X%,2 ' Default Page$(A&)="PRO2" Add_dc Endselect ' Default Page$(A&)="PRO2" Add_dc ' Inc X% ' Endselect ' ' ' Case ";" ! PRO3 ' ah bon? ' Select D% ' Case "i" ' Select E% Case "Y" ! PROGR Select F% ' Case "A" Page$(A&)="KEY ON" Add_dc Add X%,3 Case "C" Page$(A&)="KEY OFF" Add_dc Add X%,3 ' Default Page$(A&)="PRO3" Add_dc Endselect Default Page$(A&)="PRO3" Add_dc Endselect ' Case "j" ' Select E% Case "Y" ! DEPRO Select F% ' Case "A" Page$(A&)="KEY OFF" Add_dc Add X%,3 Case "C" Page$(A&)="KEY ON" Add_dc Add X%,3 ' Default Page$(A&)="PRO3" Add_dc Endselect ' Default Page$(A&)="PRO3" Add_dc ' Endselect ' Default Page$(A&)="PRO3" Add_dc ' Inc X% ' Endselect ' Case "H" Page$(A&)="FLASH ON" Add_dc Case "I" Page$(A&)="FLASH OFF" Add_dc Case "L" Page$(A&)="TAILLE.NORMALE" Add_dc Case "M" Page$(A&)="D.HAUTEUR" Add_dc Case "N" Page$(A&)="D.LARGEUR" Add_dc Case "O" Page$(A&)="D.TAILLE" Add_dc Case "X" Page$(A&)="MASQUE ON" Add_dc Case "_" Page$(A&)="MASQUE OFF" Add_dc Case "Z" Page$(A&)="LINE ON" Add_dc Case "Y" Page$(A&)="LINE OFF" Add_dc Case "]" Page$(A&)="INVERSE ON" Add_dc Case "\" Page$(A&)="INVERSE OFF" Add_dc Case "#" ' X est a [esc+1], incr‚mentation … la fin de la boucle Select Chr$(D%)+Chr$(E%) Case " X" Page$(A&)="CACHER" Add X%,2 Add_dc Case " _" Page$(A&)="MONTRER" Add X%,2 Add_dc Default Page$(A&)="ESC" Dec X% Add_dc Endselect ' Case "[" ! CSI esc + [ + ... Page$(A&)="ESC[ "+Quote$ Select D% Case "A" To "Z" Page$(A&)=Page$(A&)+Chr$(D%) Inc X% Case "0" To "9" Page$(A&)=Page$(A&)+Chr$(D%)+Chr$(E%) Add X%,2 ' Default Endselect Page$(A&)=Page$(A&)+Quote$ Add_dc ' Default ' For Z%=0 To 1 Y%=0 Do Exit if Ec$(Z%,Y%)=Chr$(C%) Inc Y% Loop until Y%>7 If Y%<=7 Exit if Ec$(Z%,Y%)=Chr$(C%) Endif Next Z% ' If Z%>1 Or Y%>7 Z%=1 Y%=Min(Y%,7) C%=0 Endif If Ec$(Z%,Y%)=Chr$(C%) If Z%=0 T$="ENCRE " Else T$="FOND " Endif T$=T$+Col$(0,Y%) Page$(A&)=T$ Clr T$ Add_dc ' Else Page$(A&)="ESC" Add_dc Dec X% ! On traite avec des Aff ÝÝ Endif ' Endselect ' Case 19 ! SEP Page$(A&)="SEP" Add_dc Case 7 Page$(A&)="BEEP" Add_dc Case 8 Page$(A&)="GAUCHE" Add_dc Case 9 Page$(A&)="DROITE" Add_dc Case 10 ' C%=Asc(Mid$(Binair$(Actb&),X%+1,1)) If Page$(Max(A&-1,0))="CRT" Page$(A&-1)="CR2" If A&=>1 If Left$(Page$(A&-1),3)="TXT" ' If Right$(Page$(A&-1),3)<>Quof$+"."+Quote$ If Instr(Page$(A&-1),Quof$+".")=0 Page$(A&-1)=Left$(Page$(A&-1),Len(Page$(A&-1))-1)+Quof$+"."+Quote$ Endif Endif Endif Else If C%=13 Inc X% If A&=>1 If Left$(Page$(A&-1),3)="TXT" ' If Right$(Page$(A&-1),3)<>Quof$+"."+Quote$ If Instr(Page$(A&-1),Quof$+".")=0 Page$(A&-1)=Left$(Page$(A&-1),Len(Page$(A&-1))-1)+Quof$+"."+Quote$ Else Page$(A&)="CR2" Add_dc Endif Else Page$(A&)="CR2" Add_dc Endif Else Page$(A&)="CR2" Add_dc Endif Else Page$(A&)="BAS" Add_dc Endif Endif Case 11 Page$(A&)="HAUT" Add_dc Case 12 Page$(A&)="'" Add_dc Page$(A&)="CLS" Add_dc Case 13 ' C%=Asc(Mid$(Binair$(Actb&),X%+1,1)) If Page$(Max(A&-1,0))="BAS" Page$(A&-1)="CR" If A&=>1 If Left$(Page$(A&-1),3)="TXT" ' If Right$(Page$(A&-1),3)<>Quof$+"."+Quote$ If Instr(Page$(A&-1),Quof$+".")=0 Page$(A&-1)=Left$(Page$(A&-1),Len(Page$(A&-1))-1)+Quof$+"."+Quote$ Endif Endif Endif ' Else If C%=10 Inc X% If A&=>1 If Left$(Page$(A&-1),3)="TXT" ' If Right$(Page$(A&-1),3)<>Quof$+"."+Quote$ If Instr(Page$(A&-1),Quof$+".")=0 Page$(A&-1)=Left$(Page$(A&-1),Len(Page$(A&-1))-1)+Quof$+"."+Quote$ Else Page$(A&)="CR" Add_dc Endif Else Page$(A&)="CR" Add_dc Endif Else Page$(A&)="CR" Add_dc Endif Else Page$(A&)="CRT" Add_dc Endif Endif Case 14 Page$(A&)="GRAPHIQUE" Add_dc Case 15 Page$(A&)="TEXTE" Add_dc Case 17 Page$(A&)="CURSEUR ON" Add_dc Case 20 Page$(A&)="CURSEUR OFF" Add_dc Case 24 ! bourrage ligne C%=Asc(Mid$(Binair$(Actb&),X%+1,1)) D%=Asc(Mid$(Binair$(Actb&),X%+2,1)) If A&>0 And ((C%=13 And D%=10) Or (C%=10 And D%=13)) ! CrLf+Bl If Left$(Page$(A&-1),3)="TXT" Page$(A&-1)=Left$(Page$(A&-1),Len(Page$(A&-1))-1)+Quof$+"*"+Quote$ Add X%,2 Else Page$(A&)="FILL" Add_dc Endif Else Page$(A&)="FILL" Add_dc Endif Case 22,25 ' C%=Asc(Mid$(Binair$(Actb&),X%+1,1)) D%=Asc(Mid$(Binair$(Actb&),X%+2,1)) Select C% ' Case "A","B","C","H","K" ' Select Chr$(C%)+Chr$(D%) ' Case "Be" Add X%,2 B%=Asc("‚") Case "Aa" Add X%,2 B%=Asc("…") Case "Ae" Add X%,2 B%=Asc("Š") Case "Au" Add X%,2 B%=Asc("—") Case "Ha" Add X%,2 B%=Asc("„") Case "He" Add X%,2 B%=Asc("‰") Case "Hi" Add X%,2 B%=Asc("‹") Case "Ho" Add X%,2 B%=Asc("”") Case "Hu" Add X%,2 B%=Asc("š") Case "Ca" Add X%,2 B%=Asc("ƒ") Case "Ce" Add X%,2 B%=Asc("ˆ") Case "Ci" Add X%,2 B%=Asc("Œ") Case "Co" Add X%,2 B%=Asc("“") Case "Cu" Add X%,2 B%=Asc("–") Case "Kc" Add X%,2 B%=Asc("‡") Default B%=-1 Endselect ' Case "z" Inc X% B%=Asc("´") Case "j" Inc X% B%=Asc("µ") Case "'" Inc X% B%=Asc("Ý") Case "#" Inc X% B%=Asc("œ") Case "<" Inc X% B%=Asc("¬") Case "=" Inc X% B%=Asc("«") Case ">" Inc X% B%=Asc("þ") Case "." Inc X% B%=Asc("¯") Case "," Inc X% B%=Asc("®") Case "{" Inc X% B%=Asc("ž") Case "1" Inc X% B%=Asc("ñ") Case "8" Inc X% B%=Asc("ö") Case "0" Inc X% B%=Asc("ø") Default B%=-1 Endselect ' If B%<>-1 Clr T$ If Left$(Page$(Max(0,A&-1)),3)="TXT" If Instr(Page$(Max(0,A&-1)),Quof$+".")=0 ! pas de cr dans cette ligne Dec A& Page$(A&)=Left$(Page$(A&),Len(Page$(A&))-1) T$=Page$(A&) Page$(A&)="" Endif Endif ' If Len(T$)=0 T$="TXT "+Quote$ Endif T$=T$+Chr$(B%) Else Page$(A&)="EM" Add_dc Endif ' ' Add X%,2 ' Case 30 Page$(A&)="HOME" Add_dc Case 31 C%=Asc(Mid$(Binair$(Actb&),X%+1,1)) D%=Asc(Mid$(Binair$(Actb&),X%+2,1)) E%=Asc(Mid$(Binair$(Actb&),X%+3,1)) F%=Asc(Mid$(Binair$(Actb&),X%+4,1)) If D%>64 And C%=>64 And D%<=104 And C%<=88 Page$(A&)="POS "+Str$(D%-64)+","+Str$(C%-64) Add X%,2 Add_dc Gosub Endtel Else if D%=>48 And C%=>48 And D%<=57 And C%<=57 ! POS 12 par ex Page$(A&)="POS 1,"+Str$((C%-48)*10+D%-48) Add X%,2 Add_dc Gosub Endtel Else If C%=&H23 And D%=&H20 And E%=&H20 And F%=&H20 E%=Asc(Mid$(Binair$(Actb&),X%+5,1)) F%=Asc(Mid$(Binair$(Actb&),X%+6,1)) If F%=&H49 ! start load drcs If E%=&H42 ! txt If Not Flag! Page$(A&)="{" Add_dc Page$(A&)="' T‚l‚chargement d'une fonte DRCS texte:" Add_dc Endif Page$(A&)="TLDRCS" Add_dc Add X%,6 A!=True ! TLC DRCS ' Else if E%=&H43 ! grf If Not Flag! Page$(A&)="{" Add_dc Page$(A&)="' T‚l‚chargement d'une fonte DRCS graphique:" Add_dc Endif Page$(A&)="GLDRCS" Add X%,6 Add_dc A!=True ! TLC DRCS ' Else Page$(A&)="OUT 31" Add_dc Gosub Endtel Endif ' Else Page$(A&)="OUT 31" Add_dc Gosub Endtel Endif Else if C%=&H23 And E%=&H30 And D%>32 ' Load drcs: ' Page$(A&)="DRSET: "+Quote$+Mid$(Binair$(Actb&),X%+2,1)+Quote$ Add_dc Add X%,3 ' Else If D%=90 And C%=90 Page$(A&)="ENDTEL" Add_dc Add X%,2 Gosub Endtel Else Page$(A&)="OUT 31" Add_dc If C%<>&H23 Gosub Endtel Endif Endif Endif Endif Case 18 ! rep C%=Asc(Mid$(Binair$(Actb&),X%+1,1))-64 If C%>0 And C%<=63 Page$(A&)="REPLIQUE "+Str$(C%) Add_dc Inc X% Else Page$(A&)="OUT 18" Add_dc Endif ' Case 0 Page$(A&)="NULL" Add_dc Case 1 Page$(A&)="SOH" Add_dc Case 2 Page$(A&)="STX" Add_dc Case 3 Page$(A&)="ETX" Add_dc Case 4 Page$(A&)="EOT" Add_dc Case 5 Page$(A&)="ENQ" Add_dc Case 6 Page$(A&)="ACK" Add_dc Case 16 Page$(A&)="DLE" Add_dc Case 21 Page$(A&)="NAK" Add_dc Case 22 Page$(A&)="SYN" Add_dc Case 23 Page$(A&)="ETB" Add_dc Case 26 Page$(A&)="CSUB" Add_dc Case 28 Page$(A&)="FS" Add_dc Case 29 Page$(A&)="GS" Add_dc ' Default Page$(A&)="OUT "+Str$(B%) Add_dc ' Endselect ' If Flag!=True ! D‚sass ascii If Len(T$)=0 ! pas en cours de txt If A&>1 ' Select Trim$(Left$(Page$(A&-1),4)) Case "TXT" ' okay Case "CR","CRT","CR2","BAS","ESC[" Select Left$(Page$(A&-2),4) Case "TXT " ' If Mid$(Page$(A&-2),Len(Page$(A&-2))-2,2)<>"%." If Instr(Page$(A&-2),Quof$+".")=0 Page$(A&-2)=Left$(Page$(A&-2),Len(Page$(A&-2))-1)+"%."+Quote$ Endif ' ' Default ' Bah pourquoi? C'est forc‚ment du texte glmblb ' Endselect Dec A& Page$(A&)="" ' Default ! code inconnu (bas? espace?) ' Select Left$(Page$(A&-2),4) Case "TXT " If Len(Page$(A&-2))=>$ And And And And Eqv Xor ' If Mid$(Page$(A&-2),Len(Page$(A&-2))-2,2)<>"%." If Instr(Page$(A&-2),Quof$+".")=0 Page$(A&-2)=Left$(Page$(A&-2),Len(Page$(A&-2))-1)+"%."+Quote$ ' Else ' Bah, on laisse comme ca, on a d‚j… un CR... Endif ' Else ! espace car ligne trop courte pour cr ' If Mid$(Page$(A&-2),Len(Page$(A&-2))-2,2)<>"%." If Instr(Page$(A&-2),Quof$+".")=0 If Mid$(Page$(A&-2),Len(Page$(A&-2))-1,1)<>Chr$(32) Page$(A&-2)=Left$(Page$(A&-2),Len(Page$(A&-2))-1)+Chr$(32)+Quote$ Endif ' Else ' Bah, on laisse comme ca, on a d‚j… un CR... Endif Endif ' ' Default ' Bah pourquoi? C'est forc‚ment du texte glmblb ' Endselect Dec A& Page$(A&)="" ' Endselect Endif Endif Endif ' Endselect Maxty&=Min(A&+2,Dims&-1) ' If A&=>1 If Left$(Page$(A&-1),3)="TXT" If Right$(Page$(A&-1),3)=Quote$+Chr$(32)+Quote$ Page$(A&-1)="SPACE" Endif Endif Endif ' If A&=>2 If Page$(A&-2)=Page$(A&-1) If A&=>3 Select Left$(Page$(A&-1),3) Case "TXT" Default If Redo!=False Redo!=True Page$(A&-2)="REDO: 2" Else Page$(A&-3)="REDO: "+Str$(Val(Mid$(Page$(A&-3),7))+1) ' 'Page$(A&-1)="" Delete Page$(A&-1) Dec A& Endif Endselect Else Redo!=True Page$(A&-2)="REDO: 2" Endif Else Redo!=False Endif Else Redo!=False Endif ' If Vtran%>0 If A&=Vtranpos%+1 If X%-Vtran%=Vtranx% If Left$(Page$(A&-2),2)="TR" Page$(A&-2)="TRANSP:" Endif Endif Vtranx%=0 Vtran%=0 Vtranpos%=0 Endif Endif ' If A&+1=>Dims& Terr$="Bloc VDT trop gros" Reponse%=True Exit if True Endif If Mod(N%,8)=0 ' If Mod(N%,96)=0 Gosub Defmouse(2) ! anim Endif ' If Fre()Maxl& Or H%=-1 ' If Len(T$)>0 T$=T$+Quote$ Page$(A&)=T$ Add_dc Clr T$ Endif ' If Len(Page$(A&))=0 Delete Page$(A&) Endif ' Gosub Defmouse(0) ~@Wind_update01(0) Page_set Wsetsl(0) Gosub Indentage ! rappel d'indentage ' If H%=-1 Gosub Menu.info("Aborted. * L:"+Str$(A&)) Clr Terr$,Terrp& Reponse%=0 Else Gosub Comm.info("M","*D‚sassembl‚.") Endif Endif ! annul‚ ' ' Else ' ' Gosub Menu.info("Erreur fenˆtre non accessible") ' Terr$="ProblŠmes internes" ' Reponse%=True ' Endif ' ~@Wind_update01(0) Return Reponse% $S% Endfunc Procedure Add_dc $S& Select T& Case 0,1 ! replace, add Inc A& Case 2 Inc A& Insert Page$(A&)="" Case 2 Endselect $S% Return Procedure Endtel ' Local T$ ' If A! ' T$=Page$(A&-1) A!=False If Not Flag! Page$(A&)="' Fin de t‚l‚chargement" Add_dc Page$(A&)="}" Add_dc Endif Endif Return ' Function Opti $F% Local A&,B&,Reponse&,Lastl&,N&,X&,Warn& Local C$ ' If Len(Binair$(Actb&))>0 ' ' ~@Wind_open(1) ' ' If Wopen!(1) ' @Oqp ' Gosub Menu.info("Compactage - en cours!") Gosub Progress(False,0,"Compactage") ' ~@Wind_update01(1) Gosub Defmouse(2) ' ' Clr C$ ' A$=Mki$(0) ' B$=Mki$(0) Void Fre(0) ' For Boucl&=0 To Len(Opti$(Actb&))\4-1 ' ' A$=Mid$(Opti$(Actb&),Boucl&*4+1,2) ' B$=Mid$(Opti$(Actb&),Boucl&*4+3,2) ' ' T$=Mid$(Binair$(Actb&),Cvi(A$),Cvi(B$)) X&=Len(Binair$(Actb&)) Clr Lastl&,N&,B& Lastl&=Asc(Left$(Binair$(Actb&),1)) A&=1 Do ' For A&=1 To X&+1 ' If Mod(A&,100)=0 Gosub Progress(False,(A&*100)\X&,"") Endif ' B&=Asc(Mid$(Binair$(Actb&),A&,1)) ' And B&<128 <- non ca marche! ' If Lastl&<>B& Or A&=X&+1 Or Warn&>0 Or N&=>64 ' If N&=>4 And Lastl&>31 And Warn&=0 C$=C$+Chr$(Lastl&)+@Repet$(N&-1) Else If Warn&>0 Dec Warn& ' If B&=27 ! Un autre esc? ' Clr Warn& ! Efface (fictif) ' Endif Endif C$=C$+String$(N&,Lastl&) Endif N&=1 ' C$=C$+Chr$(B&) Lastl&=B& ' If B&=31 ! Pos XX,YY, pas d'opti Select Mid$(Binair$(Actb&),A&+1,1) Case "#" ! Ahhrgh! T‚lDRCS (panique!) ' Inc A& Lastl&=-1 ! very important! Gosub Jmp_tel Default Warn&=3 Endselect Else if B&=27 Warn&=2 $S& Select Mid$(Binair$(Actb&),A&+1,1) Case "9",":",";" Warn&=4 ! Oula un PROx! Endselect $S% ' Endif ' Else ' Inc N& If B&=27 Warn&=2 $S& Select Mid$(Binair$(Actb&),A&+1,1) Case "9",":",";" Warn&=4 ! Oula un PROx! Endselect $S% ' Else if B&=31 ! Pos? Select Mid$(Binair$(Actb&),A&+1,1) Case "#" ! Nan un T‚lDRCs !! ' Lastl&=B& Lastl&=-1 ! very important! Gosub Jmp_tel Endselect ' Endif ' Endif ' ' ' Next A& Inc A& Loop until A&>X&+1 Gosub Progress(True,0,"") ' ' If (Cvi(B$)-Cvi(A$))+1<>Len(T$) ' C$=Left$(C$,Cvi(A$)-1)+T$+Mid$(C$,Cvi(B$)+1) ' Endif Edited!(Actb&+3)=True Binair$(Actb&)=C$ Clr C$ Void Fre(0) ' ' Next Boucl& ' ' Binair$(Actb&)=C$ ' Opti$(Actb&)="" Reponse&=0 ~@Wind_update01(0) Gosub Defmouse(0) If X&-Len(Binair$(Actb&))>0 Gosub Comm.info("M","*Compact‚. Sauv‚: "+Str$(X&-Len(Binair$(Actb&)))+" o.") Else Gosub Comm.info("M","*Compactage superflu") Endif Gosub Comm.info("M","Bloc VDT actuel: "+Str$(Actb&+1)+", longueur: "+Str$(Len(Binair$(Actb&)))+" octets.") ' ' Else ' Gosub Menu.info("Erreur fenˆtre non accessible") ' Terr$="ProblŠmes internes" ' Reponse&=-1 ' Endif ' Else ' Opti$(Actb&)="" Terr$="Optimisation: "+"Bloc VDT vide!" Reponse&=-1 Endif ' Return Reponse& Endfunc ' Sauter t‚l‚chargement Procedure Jmp_tel If Mid$(Binair$(Actb&),A&,Len(Ldt$))=Ldt$ Or Mid$(Binair$(Actb&),A&,Len(Ldg$))=Ldg$ Repeat If Lastl&=>0 C$=C$+Chr$(Lastl&) Endif Lastl&=Asc(Mid$(Binair$(Actb&),A&,1)) Inc A& Select Mid$(Binair$(Actb&),A&,1) Case 31 Select Mid$(Binair$(Actb&),A&+1,1) Case "#" ! New_Char ' Default Exit if True ! STOP (pos xx,xx) Endselect Endselect Until A&>Len(Binair$(Actb&)) C$=C$+Chr$(Lastl&) Lastl&=Asc(Mid$(Binair$(Actb&),A&,1)) C$=C$+Chr$(Lastl&) Clr N& Endif Return ' Function Desopti $F% $S& Local Y%,Reponse%,X%,Lastl&,H% Local C$ ' ' H autorisation d'optimiser Reponse%=0 If Len(Binair$(Actb&))>0 ' ' ~@Wind_open(1) ' ' If Wopen!(1) ' @Oqp ' Gosub Menu.info("D‚compactage - en cours!") ' ~@Wind_update01(1) Gosub Defmouse(2) ' Clr C$ Void Fre(0) X%=Len(Binair$(Actb&)) ' ' ' For A%=1 To X% A%=1 Do ' If Mod(A%,100)=0 Gosub Defmouse(2) ! anim Endif ' Y%=Asc(Mid$(Binair$(Actb&),A%,1)) If Y%=18 ' teste si pas d'ESCs H%=True ! autorisation d'optimiser If Asc(Mid$(Binair$(Actb&),Max(A%-1,1),1))=27 And A%=>1 H%=False ! Pas fou! ' Else ! test 1 neg If Asc(Mid$(Binair$(Actb&),Max(A%-2,$ And And And And Imp ô$1))=27 And A%=>2 Select Mid$(Binair$(Actb&),Max(A%-1,1),1) Case "9",":",";" H%=False ! Un PROx! Endselect ' Else ! test 2 neg If Asc(Mid$(Binair$(Actb&),Max(A%-3,$ And And And And Imp ô$1))=27 And A%=>3 Select Mid$(Binair$(Actb&),Max(A%-2,1),1) Case "9",":",";" H%=False ! Un PROx! Endselect Endif ! test -3 ' Endif ! test -2 Endif ! 1er test: -1 ' ' If Asc(Mid$(Binair$(Actb&),Max(A%-1,1)))=>32 ' If Asc(Mid$(Binair$(Actb&),Max(A%-2),1))=>32 ' If Asc(Mid$(Binair$(Actb&),Max(A%-3),1))<>27 If H% Inc A% Y%=Asc(Mid$(Binair$(Actb&),A%,1)) If Y%-64>0 C$=C$+String$(Y%-64,Lastl&) Else C$=C$+Chr$(Y%) Endif ' Else ' C$=C$+Chr$(Y%) ' Endif ' Else ' C$=C$+Chr$(Y%) ' Endif Else ! pas d'autorisation C$=C$+Chr$(Y%) Endif ' Else C$=C$+Chr$(Y%) Endif Lastl&=Y% ' If Len(C$)>32000 Terr$="Bloc VDT plein *"+Str$(A%) Reponse%=-1 Exit if True Endif Inc A% Loop until A%>X% ' Next A% ' If Reponse%=0 Edited!(Actb&+3)=True Binair$(Actb&)=C$ Clr C$ ~@Wind_update01(0) Gosub Defmouse(0) Gosub Comm.info("M","*D‚compact‚. Nouvelle taille: "+Str$(Len(Binair$(Actb&)))+" o.") Endif Void Fre(0) ' ' Else ' Gosub Menu.info("Erreur fenˆtre non accessible") ' Terr$="ProblŠmes internes" ' Reponse%=-1 ' Endif ' ' Else Terr$="D‚soptimisation: "+"Bloc VDT vide!" Reponse%=-1 Endif ' Return Reponse% $S% Endfunc ' ' ' ' ' E- Val - ½ROCHE Xavier 1993 ' ' ' Function Calc(Calc$) ! Calculer Local A%,Pos_loc&,Max_loc&,M%,E#,B% Local M$,E$ ' Stack_test ! Tester la pile ' Pos_loc&=Pos_e& ! Locaux Max_loc&=Max_e& ! idem (local) Add Pos_e&,Max_e&+2 ! Nos params Clr Max_e& ! Nombre d'objets M%=True ! Mode signe, type du dernier objet (0 nombre -1 op‚rat) A%=1 ! Position Do Clr M$ ! (char) Clr E$ ! 2 vars de stokage ' Print "opS:";Mid$(Calc$,A%) ' ~Inp(2) ' Select Mid$(Calc$,A%,1) ! Quel caractŠre? ' *****Le prochain objet est un nombre!***** Case "A" To "Z","0" To "9","%","&","$","_","." ' Eval|(Pos_e&)=False ! nombre! Do If A%<=Len(Calc$) M$=Mid$(Calc$,A%,1) Else ! Fin de chaine! Clr M$ Endif ' Select M$ Case "A" To "Z","0" To "9","%","&","$","_","." E$=E$+M$ Inc A% ' Default ! Fin de l'objet 'NOMBRE' While M$=Chr$(32) Inc A% M$=Mid$(Calc$,A%,1) Select M$ Case "(" ! Ce n'est pas une fonction! (Ex: 5 AND (7) ) Clr M$ ! Annuler Exit if True ! Et sortir! Endselect Wend ' Select M$ ! 1er caractŠre de l'objet suivant Case "(" ! Fonction! ( Ex: INT(..) ) ' If Mid$(Calc$,A%-1,1)="$" ! fonction $ Eval$(Pos_e&)=@Readl$(Mid$(Calc$,A%+1)) Add A%,Len(Eval$(Pos_e&))+1+1 Eval$(Pos_e&)=E$+"("+Eval$(Pos_e&)+")" Eval$(Pos_e&)=@Evals$(Eval$(Pos_e&)) Eval|(Pos_e&)=1 ! chaine! M%=False Else Inc A% ! On saute la ( Gosub Fcalc ! Evaluer fonction! M%=False ! Nombre! Endif ' Default ! Un op‚rateur? (mais on ne s'en occupe pas) ' ' Il faut ‚valuer: soit un nombre soit une variable Select Left$(E$,1) Case "0" To "9","%","&","$","." ! Nombre If Etest! If Val?(E$)<>Len(E$) Terr$="Erreur de syntaxe, nombre incompr‚hensible" Terrp&=A%-(Len(E$)-Val?(E$)) Exit if True Endif Endif Eval#(Pos_e&)=Val(E$) Clr E$ M%=False Case "A" To "Z" ! Variable Select Left$(E$,4) ! Mais lequel? Case "NOT","NEG" M%=False ! Forcer op‚rateur Endselect ' If M%=True ! Oui, c'est bien une var If Left$(E$,1)="$" Or Right$(E$,1)="$" Eval$(Pos_e&)=@Vsval$(E$) Eval|(Pos_e&)=1 ! Chaine!! M%=False ' Stop Else Eval#(Pos_e&)=@Vareval(E$) M%=False Endif ' Else ! Non, c'est un truc du genre OR Select Left$(E$,4) ! Mais lequel? Case "AND","OR","XOR" Eval$(Pos_e&)=E$ Eval|(Pos_e&)=&HFF ! Op‚rateur! M%=True Case "NOT","NEG" Eval|(Pos_e&)=&HFF Eval$(Pos_e&)=E$ ! Pas de M%=true .. ' Default ! Inconnu au bataillon! Terr$="Erreur/multiplication implicite" Terrp&=A% Exit if True Endselect Endif ' Default Terr$="Erreur de syntaxe, nombre incompr‚hensible" Terrp&=A% Exit if True Endselect Endselect Inc Pos_e& Inc Max_e& Exit if True Endselect ' ' Plus un pour fin ‚valuation! Loop until A%>Len(Calc$)+1 ' ' *****Le prochain objet est un op‚rateur!***** Case "+","-","*","/","\","^","=",">","<" ' Eval|(Pos_e&)=&HFF ! D‚clarer op‚rateur (-1 en byte) Do M$=Mid$(Calc$,A%,1) Select M$ Case " " ! Espace.. Inc A% Case "+","-","*","/","\","^","=",">","<" E$=E$+M$ Inc A% ' Default ! Fin de l'objet 'OPERATEUR' While M$=Chr$(32) Inc A% M$=Mid$(Calc$,A%,1) Wend ' ' On teste si on a pas: 'Not ---4' (Pas de Not -4!) If M%=False ! C'est le cas si on a Not.. Select Right$(E$,1) Case "-" If Pos_e&>Pos_loc&+2 ! objet >0 Select Left$(Eval$(Pos_e&-1),4) Case "NEG","NOT" ! Op‚rateurs!! M%=True ! Alors forcer NEGation! Endselect Endif Endselect Endif ' ' If M%=False ! L'objet d'avant ‚tait un nombre Eval$(Pos_e&)=E$ M%=True ' Select Right$(E$,1) Case "-" ! Ex: 2*-5 ' If Len(E$)>1 ! <> '2-5' For B%=Len(E$) Downto 0 Exit if B%=0 If Mid$(E$,B%,1)<>"-" ' autre signe, on quitte Exit if True Endif Next B% If B%=0 ! '--' = '+' ; '---' = '-' Ex: 2--5 If Even(Len(E$)) Eval$(Pos_e&)="+" Else Eval$(Pos_e&)="-" Endif ' Else ! Ex: 2*-5 If Even(Len(E$)-B%) ! '*--' = '*' Eval$(Pos_e&)=Left$(E$,B%) ! on coupe Else ! '*---' = '* Neg ' Eval$(Pos_e&)=Left$(E$,B%) ! on coupe aussi Inc Pos_e& Inc Max_e& Eval$(Pos_e&)="NEG" ! et on ajoute NEG ('-') Eval|(Pos_e&)=&HFF ! op‚rateur Endif Endif ' Endif Endselect ' Inc Pos_e& ! Incr‚mentation Inc Max_e& ! de la position-objet Exit if True ' Else ! L'objet d'avant ‚tait un op‚rateur! ' Select Left$(E$,1) Case "-" ! Signe! If Odd(Len(E$)) ! N‚gatif (nombre de '-' impairs) Eval|(Pos_e&)=&HFF ! Op‚rateur Eval$(Pos_e&)="NEG" ! N‚gation Inc Pos_e& Inc Max_e& Endif ! Sinon on ne fait rien! Exit if True ! On sort, '-' analys‚ Default If Pos_e&=Pos_loc&+2 Terr$="Une expression doit commencer par un nombre et non par une op‚ration!" Else Terr$="Erreur de syntaxe avec les signes" Endif Terrp&=A%-1 Exit if True Endselect Endif ' Endselect Loop until A%>Len(Calc$)+1 ' ' *****Le prochain objet est un nombre entre () !***** Case "(" ' Select Mid$(Calc$,A%-1,1) ! Cela finit bien par une ) ? Case ")" ! Multiplication implicite!!! Eval|(Pos_e&)=&HFF ! Op‚rateur! Eval$(Pos_e&)="*" ! Multiplication implicite Inc Pos_e& ! Position obj +1 Inc Max_e& ! et nombre obj+1 M%=False ! Idem nombre pour le suivant Endselect ' Inc A% ! Sauter la ( E$=@Readp$(Mid$(Calc$,A%)) ! Lire param Add A%,Len(E$) ! Sauter ' Select Mid$(Calc$,A%,1) ! Cela finit bien par une ) ? Case ")" Default ! Eh bien non! Terr$="Erreur de syntaxe, ) manquant" Terrp&=A% Exit if True Endselect Inc A% ! Sauter ) Eval#(Pos_e&)=@Calc(E$) ! Calculer Eval|(Pos_e&)=0 ! Ceci est un nombre! Inc Pos_e& ! Position obj +1 Inc Max_e& ! et nombre obj+1 M%=False ! Idem nombre pour le suivant ' Case "" ! Fin de chaine.. on ne fait rien! ' ' *****Le prochain objet n'est pas compr‚hensible!***** Default If Mid$(Calc$,A%,1)=Quote$ Inc A% Eval$(Pos_e&)="" While Mid$(Calc$,A%,1)<>Quote$ And A%0 Loop until A%>Len(Calc$) ! Et non pas '=>' ' ' ----------Fin de tri et d'evaluation!---------- ' If Terrp&=0 ! Pas d'erreur localis‚e? ' Pos_e&=Pos_loc&+Max_loc&+2 ! Restaurer Pos_e& ' ' Chercher en 1er les Neg,Not.. et les traiter! If Terrp&=0 ' ' Traiter en toute priorit‚ les ‚galit‚s de chaine! (A$=B$ And F$=G$ ..) Do A%=@Sfind ! Nø d'objet chaine ( + en premier ) If A%=>0 If Eval|(Pos_e&+A%+1)=&HFF ! Op ' Print "traitement: ";Eval$(Pos_e&+A%+1) ! + Select Eval$(Pos_e&+A%+1) ! + Case "+" If Eval|(Pos_e&+A%+2)=1 Eval$(Pos_e&+A%)=Eval$(Pos_e&+A%)+Eval$(Pos_e&+A%+2) @Edel(Pos_e&+A%+1) @Edel(Pos_e&+A%+1) ' Print Eval$(Pos_e&+A%) Else Terr$="addition impossible entre chaine et nombre!" Terrp&=1 Exit if True Endif Case "<>","=" ' Quand ya plus de '+" If Eval|(Pos_e&+A%+2)=1 ' Eval|(Pos_e&+A%)=&H0 ! nombre (True/False) Select Eval$(Pos_e&+A%+1) ! + ' Case "<>" Eval#(Pos_e&+A%)=(Eval$(Pos_e&+A%)<>Eval$(Pos_e&+A%+2)) Case "=" Eval#(Pos_e&+A%)=(Eval$(Pos_e&+A%)=Eval$(Pos_e&+A%+2)) ' Default Terr$=Eval$(Pos_e&+A%+1)+" impossible avec chaine!" Terrp&=1 Exit if True Endselect @Edel(Pos_e&+A%+1) @Edel(Pos_e&+A%+1) Else Terr$="comparaison impossible entre chaine et nombre!" Terrp&=1 Exit if True Endif Default Terr$=Eval$(Pos_e&+A%+1)+" impossible avec chaine!" Terrp&=1 Exit if True Endselect Endif Endif Loop until A%<0 ' If Terrp&=0 ! Pas d'erreur localis‚e? ' Do A%=@Efind("NEG") M%=@Efind("NOT") Exit if A%<0 And M%<0 If A%=>0 Or M%=>0 If A%<0 A%=M% Else if M%<0 M%=A% Endif A%=Min(A%,M%) M%=A% While Eval|(Pos_e&+A%)=&HFF Select Eval$(Pos_e&+A%) Case "NEG","NOT" Default Terr$="Erreur de syntaxe avec NEG/NOT" Terrp&=1 Exit if True Endselect Inc A% Wend Exit if Terrp&<>0 M%=A%-1 While Eval|(Pos_e&+M%)=&HFF Select Eval$(Pos_e&+M%) Case "NOT" Eval#(Pos_e&+M%+1)=Not Eval#(Pos_e&+M%+1) @Edel(Pos_e&+M%) Dec M% Case "NEG" Eval#(Pos_e&+M%+1)=-Eval#(Pos_e&+M%+1) @Edel(Pos_e&+M%) Dec M% ' Case "+","-","*","/","\","^","=",">","<" Default Exit if True Endselect Wend Endif Loop ' ' V‚rifier coh‚rence de l'expresion If Eval|(Pos_e&)=&HFF Or Eval|(Pos_e&)=1 Terr$="Une expression doit commencer par un nombre et non par une op‚ration!" Terrp&=1 Else If Max_e&>0 If Eval|(Pos_e&+Max_e&-1)=&HFF Or Eval|(Pos_e&+Max_e&-1)=1 Terr$="Une expression doit finir par un nombre et non par une op‚ration!" Terrp&=Len(Calc$) Endif Endif Endif ' ''' ' Ici on ‚value tous les op‚rateurs (^*/\+- etc..) M%=0 ! Niveau de priorit‚ math‚matique Do B%=0 ! Num‚ro d'objet Do If Eval|(Pos_e&+B%)=&HFF ! Op‚rateur! If Eval|(Pos_e&+B%-1)=0 And Eval|(Pos_e&+B%+1)=0 ' ' Select M% ! Niveau? ' Case 0 Select Eval$(Pos_e&+B%) Case "^" Eval#(Pos_e&+B%-1)=Eval#(Pos_e&+B%-1)^Eval#(Pos_e&+B%+1) @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Endselect Case 1 Select Eval$(Pos_e&+B%) Case "*" Eval#(Pos_e&+B%-1)=Eval#(Pos_e&+B%-1)*Eval#(Pos_e&+B%+1) @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Case "/" If Eval#(Pos_e&+B%+1)=0 If Not Etest! ! nous ne sommes pas en mode test Terr$="Division par z‚ro" Terrp&=1 Exit if True Endif Else Eval#(Pos_e&+B%-1)=Eval#(Pos_e&+B%-1)/Eval#(Pos_e&+B%+1) Endif @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Case "\" If Eval#(Pos_e&+B%+1)=0 If Not Etest! ! nous ne sommes pas en mode test Terr$="Division par z‚ro" Terrp&=1 Exit if True Endif Else Eval#(Pos_e&+B%-1)=Eval#(Pos_e&+B%-1)\Eval#(Pos_e&+B%+1) Endif @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Endselect Case 2 Select Eval$(Pos_e&+B%) Case "+" Eval#(Pos_e&+B%-1)=Eval#(Pos_e&+B%-1)+Eval#(Pos_e&+B%+1) @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Case "-" Eval#(Pos_e&+B%-1)=Eval#(Pos_e&+B%-1)-Eval#(Pos_e&+B%+1) @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Endselect Case 3 Select Eval$(Pos_e&+B%) Case "=" Eval#(Pos_e&+B%-1)=(Eval#(Pos_e&+B%-1)=Eval#(Pos_e&+B%+1)) @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Case ">" Eval#(Pos_e&+B%-1)=(Eval#(Pos_e&+B%-1)>Eval#(Pos_e&+B%+1)) @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Case "<" Eval#(Pos_e&+B%-1)=(Eval#(Pos_e&+B%-1)",">=" Eval#(Pos_e&+B%-1)=(Eval#(Pos_e&+B%-1)=>Eval#(Pos_e&+B%+1)) @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Case "<=","=<" Eval#(Pos_e&+B%-1)=(Eval#(Pos_e&+B%-1)<=Eval#(Pos_e&+B%+1)) @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Case "==" Eval#(Pos_e&+B%-1)=(Eval#(Pos_e&+B%-1)==Eval#(Pos_e&+B%+1)) @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Case "<>","><" Eval#(Pos_e&+B%-1)=(Eval#(Pos_e&+B%-1)==Eval#(Pos_e&+B%+1)) @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Endselect Case 4 Select Eval$(Pos_e&+B%) Case "AND" Eval#(Pos_e&+B%-1)=(Eval#(Pos_e&+B%-1) And Eval#(Pos_e&+B%+1)) @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Case "OR" Eval#(Pos_e&+B%-1)=(Eval#(Pos_e&+B%-1) Or Eval#(Pos_e&+B%+1)) @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Case "XOR" Eval#(Pos_e&+B%-1)=(Eval#(Pos_e&+B%-1) Xor Eval#(Pos_e&+B%+1)) @Edel(Pos_e&+B%) @Edel(Pos_e&+B%) Dec B% Endselect Endselect ' Fin d'‚valuation des op‚rateurs ' ' For A%=Pos_loc&+Max_loc&+2 To Pos_loc&+Max_loc&+2+Max_e&-1 ' If Eval|(A%)=0 ' Print "[";Eval#(A%);"] "; ' Else ' Print "'"+Eval$(A%)+"' "; ' Endif ' Next A% ' ~Inp(2) ' Else Terr$="Erreur de syntaxe avec l'op‚rateur" Terrp&=1 Endif ' Else if Eval|(Pos_e&+B%)=1 ! Chaine! Endif Inc B% Loop until B%=>Max_e& Inc M% Loop until M%>5 Or Max_e&=1 ' ' ----------Ici on a tout ‚valu‚!---------- ' ' On range, on v‚rifie.. et on renvoi! If Max_e&<>1 And Terrp&=0 If Max_e&<>0 ! bin oui, une chaine vide! ' Terr$="Erreur arithm‚tique inconnue" M%=True ! Simuler op. au d‚but For A%=Pos_e& To Pos_e&+Max_e&-1 If Eval|(A%)=&HFF Terr$="Op‚rateur inconnu: "+Eval$(A%) Else If M%=True M%=False Else Terr$="Erreur/multiplication implicite" Endif Endif Next A% Terrp&=1 Else ! chaine unique! Eval#(Pos_e&)=0 ' Endif Endif Endif Endif Endif ' If Len(Terr$)>0 Or Terrp&<>0 If Terrp&=0 Terrp&=1 Endif If Len(Terr$)=0 Terr$="Erreur interne inconnue - structure" Endif Eval#(Pos_e&)=0 Endif ' E#=Eval#(Pos_e&) Pos_e&=Pos_loc& Max_e&=Max_loc& ' Return E# ! Valeur de r‚ponse Endfunc ' Function Efind(E$) ! Chercher op‚rateur E$ $F% Local A% ' ' Note: Pos_e& doit pointer sur l'objet 0 ! A%=0 If Max_e&>1 Do If Eval|(Pos_e&+A%)=&HFF If Eval$(Pos_e&+A%)=E$ A%=A%+100000 Exit if True Endif Endif Inc A% Loop until A%>Max_e&-1 Endif If A%=>100000 Sub A%,100000 Else A%=-1 Endif Return A% Endfunc ' Function Sfind ! Chercher chaine, avec "+" en premier! $F% Local A%,N% ' ' Note: Pos_e& doit pointer sur l'objet 0 ! If Max_e&>1 A%=0 N%=0 Do If Eval|(Pos_e&+A%)=1 ! chaine If Eval$(Pos_e&+A%+1)="+" ! addition A%=A%+100000 Exit if True Else if A%Max_e&-1 Endif If A%<100000 If N%=>100000 A%=N% Endif Endif If A%=>100000 Sub A%,100000 Else A%=-1 Endif Return A% Endfunc Procedure Edel(N%) ! D‚truire Ne objet.. et d‚caler! Delete Eval$(N%) Delete Eval#(N%) Delete Eval|(N%) Dec Max_e& Return ' Function Vareval(E$) ! Valeur de variable E$ (S.G.V.E.) Return @Vnval(E$) Endfunc ' Function Strform$(E$) ! Epurer expression Local A%,B%,C%,M%,X% ' N%=1 B%=Asc("+") C%=0 M%=False X%=Asc(Quote$) E$=Trim$(E$) A%=1 Do C%=Asc(Mid$(E$,A%,1)) If C%=X% M%=Not M% Else If M%=0 C%=Asc(Upper$(Chr$(C%))) Mid$(E$,A%,1)=Chr$(C%) Select C% Case 32 Select B% Case "A" To "Z","0" To "9","_","." Default E$=Left$(E$,A%-1)+Mid$(E$,A%+1) Dec A% Endselect Case "A" To "Z","0" To "9","%","&","$","_","." Case "+","-","*","/","\","^","=",">","<" Case "(",")","," Case "[","{" Mid$(E$,A%,1)="(" Case "]","}" Mid$(E$,A%,1)=")" Case "~" Mid$(E$,A%,1)="$" Case ";","'" Mid$(E$,A%,1)="+" Case "" ! Fin de chaine Default Terr$="Erreur de syntaxe ou caractŠre ill‚gal: "+Chr$(C%) Endselect ' Else ! On es dans une chaine ' Select C% Case "%" Inc A% Endselect Endif Endif Inc A% B%=C% Loop until A%>Len(E$) Or Terrp&<>0 Return E$ Endfunc ' Function Readp$(Right$) ! Lire paramŠtre chaine/num Local A%,B%,C%,L%,M%,P% ' B%=Asc(Quote$) L%=Len(Right$) A%=0 C%=0 P%=0 Do Inc A% M%=Asc(Mid$(Right$,A%,1)) If M%=B% If C%=0 C%=-1 Else C%=0 Endif Else Select M% Case "%" If C%=-1 Inc A% Endif Case "(" If C%=0 Inc P% Endif Case ")" If C%=0 Dec P% Endif Case "," If C%=0 If P%=0 P%=-15 Endif Endif Endselect Endif If P%<0 Dec A% Endif Exit if P%<0 Loop until A%=>L% If P%<>-15 And P%>0 If P%>0 Terr$="Pas assez de )" Endif Terrp&=1 Else Return Left$(Right$,A%) Endif Return "" Endfunc ' ' Idem readp mais on conserve les ',' (on ne s'arrˆte pas l…) Function Readl$(Right$) ! Lire liste de paramŠtres chaine Local A%,B%,C%,L%,M%,P% ' B%=Asc(Quote$) L%=Len(Right$) A%=0 C%=0 P%=0 Do Inc A% M%=Asc(Mid$(Right$,A%,1)) If M%=B% If C%=0 C%=-1 Else C%=0 Endif Else Select M% Case "%" If C%=-1 Inc A% Endif Case "(" If C%=0 Inc P% Endif Case ")" If C%=0 Dec P% Endif Endselect Endif If P%<0 Dec A% Endif Exit if P%<0 Loop until A%=>L% If P%<>-15 And P%>0 If P%>0 Terr$="Pas assez de )" Endif Terrp&=1 Else Return Left$(Right$,A%) Endif Return "" Endfunc ' Procedure Eval_init ! Init Quote$=Chr$(34) Quof$="%" Max_eval&=200 Dim Eval#(Max_eval&+8),Eval$(Max_eval&+8),Eval|(Max_eval&+8) Max_e&=0 Pos_e&=0 Return ' Procedure Clear_eval ! Clear Local A% Clr Terr$,Terrp& Arrayfill Eval#(),0 Arrayfill Eval|(),0 For A%=0 To Max_eval& Eval$(A%)="" Next A% Clr Max_e&,Pos_e& Return ' Procedure Eval_uninit ! Uninit Clr Max_e&,Pos_e& Erase Eval#(),Eval|(),Eval$() Return ' Procedure Fcalc ! Calculer fonction (Int(), etc..) Local Pos_loc&,Max_loc&,N# Local M$ ' Stack_test ! Tester la pile ' Pos_loc&=Pos_e& Max_loc&=Max_e& Add Pos_e&,Max_e&+2 Clr Max_e& Clr M$ M%=0 Dec A% Do Inc A% M$=@Readp$(Mid$(Calc$,A%)) Add A%,Len(M$) If Len(M$)>0 Eval$(Pos_e&)=M$ Inc Pos_e& Inc Max_e& Else Exit if True Endif Loop until Mid$(Calc$,A%,1)=")" Or A%=>Len(Calc$) Clr M$ Pos_e&=Pos_loc&+Max_loc&+2 ' If Terrp&=0 $S% Select Left$(E$,4) ' ' Op‚rations arithm‚tiques Case "ADD" ! addition entiŠre If @Tstcalc("II") N#=Add(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "DIV" ! division entiŠre If @Tstcalc("II") If Eval#(Pos_e&+1)=0 If Not Etest! ! nous ne sommes pas en mode test Terr$="Division par z‚ro" Terrp&=1 Endif Else N#=Div(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Endif Case "MOD" ! reste de la divison entiŠre If @Tstcalc("II") If Eval#(Pos_e&+1)=0 If Not Etest! ! nous ne sommes pas en mode test Terr$="Division par z‚ro" Terrp&=1 Endif Else N#=Mod(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Endif Case "MUL" ! multiplication entiŠre If @Tstcalc("II") N#=Mul(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "SUB" ! soustraction entiŠre If @Tstcalc("II") N#=Sub(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif ' ' Fonctions num‚riques Case "ABS" ! valeur absolue If @Tstcalc("N") N#=Abs(Eval#(Pos_e&)) Endif Case "EVEN" ! Pair? If @Tstcalc("I") N#=Even(Eval#(Pos_e&)) Endif Case "EXP" ! e^t If @Tstcalc("N") N#=Exp(Eval#(Pos_e&)) Endif Case "FAC","FACT" ! factorielle If @Tstcalc("I") N#=@Fac(Eval#(Pos_e&)) Endif Case "FIX" ! partie entiŠre (=trunc) If @Tstcalc("N") N#=Fix(Eval#(Pos_e&)) Endif Case "FRAC","FRC" ! partie d‚cimale If @Tstcalc("N") N#=Frac(Eval#(Pos_e&)) Endif Case "INT" ! partie entiŠre If @Tstcalc("N") N#=@Xint(Eval#(Pos_e&)) Endif Case "LOG","LN" ! log n‚p‚rien If @Tstcalc("N") If Eval#(Pos_e&)<=0 If Not Etest! ! nous ne sommes pas en mode test Terr$="Logarithme n‚gatif impossible" Terrp&=1 Endif Else N#=Log(Eval#(Pos_e&)) Endif Endif Case "LOG1","LG10" ! log d‚cimal If @Tstcalc("N") If Eval#(Pos_e&)<=0 If Not Etest! ! nous ne sommes pas en mode test Terr$="Logarithme n‚gatif impossible" Terrp&=1 Endif Else N#=Log10(Eval#(Pos_e&)) Endif Endif Case "ODD" ! nombre impair? If @Tstcalc("I") N#=Odd(Eval#(Pos_e&)) Endif Case "PRED","PRD" ! nombre infŠrieur (int(n)-1) If @Tstcalc("N") N#=Pred(Eval#(Pos_e&)) Endif Case "ROUN" ! arrondie (rounD) If @Tstcalc("Nn") If Max_e&=1 N#=Round(Eval#(Pos_e&)) Else N#=Round(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Endif Case "SGN","SIGN" ! signe If @Tstcalc("N") N#=Sgn(Eval#(Pos_e&)) Endif Case "SQR" ! racine carr‚e If @Tstcalc("N") If Eval#(Pos_e&)<=0 If Not Etest! ! nous ne sommes pas en mode test Terr$="Racine n‚gative impossible" Terrp&=1 Endif Else N#=Sqr(Eval#(Pos_e&)) Endif Endif Case "SQRE" ! carr‚ If @Tstcalc("N") N#=Eval#(Pos_e&)*Eval#(Pos_e&) Endif Case "SUCC" ! successeur (int()+1) If @Tstcalc("N") N#=Succ(Eval#(Pos_e&)) Endif Case "TRUN","TRNC" ! tronquer (=FIX) If @Tstcalc("N") N#=Trunc(Eval#(Pos_e&)) Endif ' ' Fonctions trigonom‚triques Case "ACOS" ! ArcCosinus [-1..1] If @Tstcalc("N") If Not (Eval#(Pos_e&)=>-1 And Eval#(Pos_e&)<=1) If Not Etest! ! nous ne sommes pas en mode test Terr$="Erreur ACos" Terrp&=1 Endif Else N#=Acos(Eval#(Pos_e&)) Endif Endif Case "ASIN" ! ArcSinus [-1..1] If @Tstcalc("N") If Not (Eval#(Pos_e&)=>-1 And Eval#(Pos_e&)<=1) If Not Etest! ! nous ne sommes pas en mode test Terr$="Erreur ASin" Terrp&=1 Endif Else N#=Acos(Eval#(Pos_e&)) Endif Endif Case "ATN","ATAN" ! ArcTang If @Tstcalc("N") N#=Atn(Eval#(Pos_e&)) Endif Case "COS" ! Cosinus If @Tstcalc("N") N#=Cos(Eval#(Pos_e&)) Endif Case "COSQ" ! Cosinus Quick If @Tstcalc("N") N#=Cosq(Eval#(Pos_e&)) Endif Case "DEG" ! Rad->Deg If @Tstcalc("N") N#=Deg(Eval#(Pos_e&)) Endif Case "RAD" ! Rad->Deg If @Tstcalc("N") N#=Rad(Eval#(Pos_e&)) Endif Case "SIN" ! Sinus If @Tstcalc("N") N#=Sin(Eval#(Pos_e&)) Endif Case "SINQ" ! Sinus Quick If @Tstcalc("N") N#=Sinq(Eval#(Pos_e&)) Endif Case "TAN" ! Tangente If @Tstcalc("N") N#=Tan(Eval#(Pos_e&)) Endif ' ' Op‚rations de comparaison Case "MAX" ! Maximum d'une liste If Max_e&>0 N#=@F_multi(1) ! maximum Else Terr$="Pas assez de paramŠtres dans "+E$+"()" Terrp&=1 Endif Case "MIN" ! Minimum d'une liste If Max_e&>0 N#=@F_multi(0) ! minimum Else Terr$="Pas assez de paramŠtres dans "+E$+"()" Terrp&=1 Endif ' ' Op‚rations sur des listes Case "SUM" ! somme If Max_e&>0 N#=@F_multi(2) ! minimum Else Terr$="Pas assez de paramŠtres dans "+E$+"()" Terrp&=1 Endif Case "PROD" ! produit If Max_e&>0 N#=@F_multi(3) ! minimum Else Terr$="Pas assez de paramŠtres dans "+E$+"()" Terrp&=1 Endif ' ' Op‚rations de base Case "NBAS" ! base If @Tstcalc("PP") ! Str$(N(1)) en base N(2) N#=@Base(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif ' ' Op‚rations de bits Case "AND" ! conjonction If @Tstcalc("II") N#=And(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "BCHG" ! inversion de bit If @Tstcalc("IP") N#=Bchg(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "BCLR" ! annulation d'un bit If @Tstcalc("IP") N#=Bclr(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "BSET" ! fixation d'un bit If @Tstcalc("IP") N#=Bset(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "BTST" ! tester un bit If @Tstcalc("IP") N#=Btst(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "BYTE" ! octet faible non sign‚ If @Tstcalc("I") N#=Byte(Eval#(Pos_e&)) Endif Case "CARD" ! mot faible non sign‚ If @Tstcalc("I") N#=Card(Eval#(Pos_e&)) Endif Case "EQV" ! fonct d'‚quivalence If @Tstcalc("NN") N#=Eqv(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "IMP" ! fonct d'implication If @Tstcalc("NN") N#=Imp(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "NEG" ! n‚gation If @Tstcalc("N") N#=-Eval#(Pos_e&) Endif Case "NOT" ! inversion If @Tstcalc("N") N#=Not (Eval#(Pos_e&)) Endif Case "OR" ! disjonction If @Tstcalc("II") N#=Or(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "SHL" ! d‚calage de bits vers la gauche If @Tstcalc("IP") N#=Shl(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "SHR" ! d‚calage de bits vers la droite If @Tstcalc("IP") N#=Shr(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "ROL" ! rotation de bits vers la gauche If @Tstcalc("IP") N#=Rol(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "ROR" ! rotation de bits vers la droite If @Tstcalc("IP") N#=Ror(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "SWAP" ! echange mots faible-forts If @Tstcalc("I") N#=Swap(Eval#(Pos_e&)) Endif Case "WORD" ! ‚tendre … 32 bits If @Tstcalc("I") N#=Word(Eval#(Pos_e&)) Endif Case "XOR" ! ou exclusif If @Tstcalc("II") N#=Xor(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif ' ' G‚n‚ration de nombres al‚atoires Case "RAND" ! RANDOM If @Tstcalc("P") N#=Random(Eval#(Pos_e&)) Endif Case "RND" ! (param fictif) If @Tstcalc("i") N#=Rnd(Eval#(Pos_e&)) Endif ' ' Conversions de donn‚es (peu utilis‚es) Case "CFLO" ! Int->Float If @Tstcalc("N") N#=Cfloat(Eval#(Pos_e&)) Endif Case "CINT" ! Float->Int (Int arrondie) If @Tstcalc("N") N#=Cint(Eval#(Pos_e&)) Endif ' ' ' Fonctions semi-num‚riques Case "ASC" ! Code ascii (char) ; nombre sur 8 bits If @Tstcalc("S") N#=Asc(Left$(Eval$(Pos_e&),1)) Endif Case "CVI" ! 2char->Nombre sur 16 bits If @Tstcalc("S") N#=Cvi(Left$(Eval$(Pos_e&),2)) Endif Case "CVL" ! 4char->Nombre sur 32 bits If @Tstcalc("S") N#=Cvl(Left$(Eval$(Pos_e&),4)) Endif Case "CVS" ! 4char->R‚el atari If @Tstcalc("S") N#=Cvs(Left$(Eval$(Pos_e&),4)) Endif Case "CVF" ! 6char->R‚el gfa2 If @Tstcalc("S") N#=Cvf(Left$(Eval$(Pos_e&),6)) Endif Case "CVD" ! 8char->R‚el gfa3 ou Mbasic If @Tstcalc("S") N#=Cvd(Left$(Eval$(Pos_e&),8)) Endif Case "EQUS","STRE" ! Egalite de chaine If @Tstcalc("SS") N#=(Eval$(Pos_e&)=Eval$(Pos_e&+1)) Endif Case "NEQU","STRN" ! Non-‚galite de chaine If @Tstcalc("SS") N#=(Eval$(Pos_e&)<>Eval$(Pos_e&+1)) Endif Case "INST" ! Rechercher chaine de caractŠres If @Tstcalc("SSp") If Max_e&=2 N#=Instr(Eval$(Pos_e&),Eval$(Pos_e&+1)) Else N#=Instr(Eval$(Pos_e&),Eval$(Pos_e&+1),Eval#(Pos_e&+2)) Endif Endif Case "LEN" ! Longueur d'une chaine If @Tstcalc("S") N#=Len(Eval$(Pos_e&)) Endif Case "RINS" ! Rechercher chaine de caractŠres en partant de la fin If @Tstcalc("SSp") If Max_e&=2 N#=Rinstr(Eval$(Pos_e&),Eval$(Pos_e&+1)) Else N#=Rinstr(Eval$(Pos_e&),Eval$(Pos_e&+1),Eval#(Pos_e&+2)) Endif Endif Case "VAL" ! Chaine->Num‚rique If @Tstcalc("S") Eval$(Pos_e&)=@Strform$(Eval$(Pos_e&)) If Terrp&<>0 Terr$="Val()/"+Terr$ Else N#=@Calc(Eval$(Pos_e&)) If Terrp&<>0 Select Left$(Terr$,4) Case "Val(" ! Deja erreur (r‚cursive??) Terr$=Left$(Terr$,4)+Str$(1+Val(Mid$(Terr$,5,Instr(Terr$,")")-1)))+Mid$(Terr$,Instr(Terr$,")")) Default Terr$="Val()/"+Terr$ Endselect Endif Endif Endif ' ' Op‚rations de base en semi-num‚rique Case "BASE" ! S en base N If @Tstcalc("SP") N#=@Sbase(Eval$(Pos_e&),Eval#(Pos_e&+1)) Endif ' ' Propre au logiciel - Fcalc Case "PAR" ! Param If @Tstcalc("P") If Eval#(Pos_e&)=>1 And Eval#(Pos_e&)<=10 N#=Procx#(Eval#(Pos_e&)-1) Else If Not Etest! Terr$="ParamŠtre incorrect"+", [1..10] "+"attendu" Terrp&=1 Endif Endif Endif Case "VAR" If @Tstcalc("P") If Eval#(Pos_e&)=>1 And Eval#(Pos_e&)<=26 N#=@Vnval(Chr$(Eval#(Pos_e&)+64)) Else If Not Etest! Terr$="ParamŠtre incorrect"+", [1..26] "+"attendu" Terrp&=1 Endif Endif Endif ' ' Default Terr$="Fonction inconnue: "+E$ Terrp&=A% Endselect Endif ' Pos_e&=Pos_loc& Max_e&=Max_loc& Inc A% Eval#(Pos_e&)=N# Eval|(Pos_e&)=0 ' Pas de Inc Pos_loc& et Inc Max_e&, cela sera fait + tard ! ' Return Function Tstcalc(A$) ! 'N/n/S/s...' (sous routine) $F% Local A% ' ' N/I: nombre (I=int) ; S: string - minuscules= params optionnels (… la fin!) ' A%=Len(A$) While Btst(Asc(Mid$(A$,A%,1)),5) And A%>0 Dec A% Wend ' If Max_e&Len(A$) Terr$="Trop de paramŠtres dans "+E$+"()" Terrp&=1 Else ' For A%=0 To Max_e&-1 Select Mid$(A$,A%+1,1) Case "N","n" ! Nombre Eval#(Pos_e&+A%)=@Calc(Eval$(Pos_e&+A%)) Exit if Terrp&<>0 Case "I","i" ! Integer (4 octets) Eval#(Pos_e&+A%)=@Xint(@Calc(Eval$(Pos_e&+A%))) Exit if Terrp&<>0 Case "P","p" ! Integer non sign‚ (4 octets) Eval#(Pos_e&+A%)=@Xint(@Calc(Eval$(Pos_e&+A%))) Exit if Terrp&<>0 If Eval#(Pos_e&+A%)<0 Eval#(Pos_e&+A%)=Abs(Eval#(Pos_e&+A%)) If Not Etest! ! nous ne sommes pas en mode test Terr$="Mauvais paramŠtre dans "+E$+"(): n‚gatif" Terrp&=1 Exit if True Endif Endif Case "S","s" ! String Eval$(Pos_e&+A%)=@Evals$(Eval$(Pos_e&+A%)) Exit if Terrp&<>0 Endselect Next A% Endif ' If Terrp&=0 Return -1 Else Return 0 Endif Endfunc ' Function F_multi(Flag&) ! 0 Min 1 Max 2 Sum 3 Prod Local A%,N# ' Eval#(Pos_e&)=@Calc(Eval$(Pos_e&)) N#=Eval#(Pos_e&) ! Premier paramŠtre ' ' On execute la suite (min,max,somme,etc..) If Max_e&>1 For A%=1 To Max_e&-1 Eval#(Pos_e&+A%)=@Calc(Eval$(Pos_e&+A%)) Select Flag& Case 1 ! Maximum If Eval#(Pos_e&+A%)>N# N#=Eval#(Pos_e&+A%) Endif Case 0 ! Minimum If Eval#(Pos_e&+A%)0 Next A% Endif Return N# Endfunc ' ' Factorielle rapide (pas de d‚lires r‚cursifs!) Function Fac(N%) Local A%,E# ' If N%<450 ! Limite des capacit‚s: 3.85*10^997 !! ... E#=1 If N%>0 For A%=1 To N% E#=E#*A% Next A% Endif Else Terr$="Factorielle trop grande" Terrp&=1 Endif Return E# Endfunc ' Function Base(X%,N%) ! X en base N Local A$ A$=Str$(X%) ! Convertir en chaine ' Return @Sbase(A$,N%) Endfunc ' Function Sbase(A$,N%) ! A$ en base N Local A%,X%,N# ' N#=0 If N%>1 If N%<=256 A%=0 While Len(A$)-A%>0 X%=Asc(Mid$(A$,Len(A$)-A%,1)) ! Valeur du Ae caractŠre If N%<=36 Select X% Case "0" To "9" X%=X%-48 Case "A" To "Z" X%=X%-65+10 Case "a" To "z" X%=Bclr(X%,5)-65+10 Default ! On laisse comme cha Endselect Endif ! Base>36 on laisse comme tel ' If X%=>N% ! Erreur dans la base Terr$="D‚passement de base: "+Mid$(A$,Len(A$)-A%,1) Terrp&=1 Exit if True Else N#=N#+(X%*(N%^A%)) Endif Inc A% Wend Else Terr$="Base >256 impossible" Terrp&=1 Endif Else Terr$="Base <=1 impossible" Terrp&=1 Endif Return N# ' Endfunc ' ' ' ' SystŠme de Gestion de Variables Etendues - ½ROCHE Xavier 1993 ' ' ' Procedure Vxinit Maxv%=99 Dim Var$(Maxv%),Idxs$(Maxv%) Dim Var#(Maxv%),Idxn$(Maxv%) Return ' Procedure Clearvars Local A% For A%=0 To Maxv% Var$(A%)="" Idxn$(A%)="" Idxs$(A%)="" Next A% Arrayfill Var#(),0 Return ' Procedure Vxuninit Erase Var#(),Var$(),Idxs$(),Idxn$() Clr Maxv% Return ' Procedure Vncreate(E$) Local A% ' If @Vnexist(E$)=-1 A%=0 While Len(Idxn$(A%))>0 Inc A% Exit if A%>Maxv% Wend If A%>Maxv% Terr$="Impossible de d‚clarer plus de "+Str$(Maxv%+1)+" vars!" Terrp&=1 Else Idxn$(A%)=E$ Var#(A%)=0 Endif Endif Return ' Procedure Vscreate(E$) Local A% ' E$=@Vsform$(E$) If @Vsexist(E$)=-1 A%=0 While Len(Idxs$(A%))>0 Inc A% Exit if A%>Maxv% Wend If A%>Maxv% Terr$="Impossible de d‚clarer plus de "+Str$(Maxv%+1)+" vars$!" Terrp&=1 Else Idxs$(A%)=E$ Var$(A%)="" Endif Endif Return ' Function Vnexist(E$) Local A% ' A%=0 While Idxn$(A%)<>E$ Inc A% Exit if A%=>Maxv% Exit if Len(Idxn$(A%))=0 Wend If Idxn$(A%)=E$ Return A% Else Return -1 Endif Endfunc ' Function Vsexist(E$) Local A% ' A%=0 E$=@Vsform$(E$) While Idxs$(A%)<>E$ Inc A% Exit if A%=>Maxv% Exit if Len(Idxs$(A%))=0 Wend If Idxs$(A%)=E$ Return A% Else Return -1 Endif Endfunc ' Function Vnval(E$) Local A% ' A%=@Vnexist(E$) If A%<>-1 Return Var#(A%) Else ' Select Left$(E$,4) Case "PI" ! Pi,3.141592653589... Return Pi Case "EXP","E" ! Nombre d'Euler Return Exp(1) Case "TRUE","VRAI" ! $FFFFFFFF Return -1 Case "FALS","NULL","FAUX" ! $0 Return 0 Case "RND" ! rand Return Rnd ' Default ! Inconnu.. Return @Resvaln(E$) ! Var r‚serv‚e? Endselect Endif Endfunc ' Function Vsval$(E$) Local A% ' E$=@Vsform$(E$) A%=@Vsexist(E$) If A%<>-1 Return Var$(A%) Else E$=@Resval$(E$) ! var r‚serv‚e? If Len(E$)=0 Return "" Else Return E$ Endif Endif Endfunc ' Procedure Vnset(E$,E#) Local A% ' A%=@Vnexist(E$) If A%=-1 Gosub Vncreate(E$) A%=@Vnexist(E$) Endif If A%=>0 Var#(A%)=E# Else If Terrp&=0 Terr$="Impossible de cr‚er "+E$ Terrp&=1 Endif Endif Return ' Procedure Vsset(E$,A$) Local A% ' E$=@Vsform$(E$) A%=@Vsexist(E$) If A%=-1 Gosub Vscreate(E$) A%=@Vsexist(E$) Endif If A%=>0 Var$(A%)=A$ Else If Terrp&=0 Terr$="Impossible de cr‚er "+E$ Terrp&=1 Endif Endif Return ' Function Vsform$(E$) If Right$(E$,1)="$" E$=Left$(E$,Len(E$)-1) Endif If Left$(E$,1)="$" E$=Mid$(E$,2) Endif Return E$ Endfunc ' Procedure Vndel(E$) Local A% ' A%=@Vnexist(E$) If A%=>0 Delete Var#(A%) Delete Idxn$(A%) Endif Return ' Procedure Vsdel(E$) Local A% ' E$=@Vsform$(E$) A%=@Vsexist(E$) If A%=>0 Delete Var$(A%) Delete Idxs$(A%) Endif Return ' ' ' Routines Annexes - ½ROCHE Xavier 1993 ' ' V‚rifier la pile Procedure Stack_test If Pos_e&+Max_e&+12=>Max_eval& Terr$="D‚passement de pile" Terrp&=1 Endif Return ' ' Var r‚serv‚es (alpha) Function Resval$(E$) ' Select Left$(E$,4) Case "RTD" Return Rtd$ ' Case "CLS" Return Cls$ Case "MAJ" Return Maj$ Case "MIN" Return Min$ Case "40CO" Return Col40$ Case "F80C" Return Col80$ Case "A80C" Return Col80a$ ! am‚ricain Case "DRCT" ! Drcs txt If Right$(E$,3)<>"OFF" Return Drcton$ Else Return Drctoff$ Endif Case "DRCG" ! Drcs grf If Right$(E$,3)<>"OFF" Return Drcgon$ Else Return Drcgoff$ Endif Case "TLDR" ! stload text Return Ldt$ Case "GLDR" ! stload graph Return Ldg$ Case "ENDT" ! end tel drcs Return Chr$(31)+"ZZ" ! pos bidon (pas de pos) ' Case "KEY" ! key on/off If Right$(E$,3)<>"OFF" Return Kon$ Else Return Koff$ Endif Case "CLL" Return Cll$ Case "NULL" Return Chr$(0) Case "RESE" ! t Return Reset$ Case "TEXT" ! e Return Text$ Case "GRAP" ! hique Return Graph$ Case "BEEP" Return Beep$ Case "CR" Return Cr$ Case "CR2" Return Cr2$ Case "CRH" Return Crt$+C_h$ Case "CRT" Return Crt$ Case "HOME" Return Home$ Case "FILL","BLL","BL" Return Bl$ ' Case "HAUT" Return C_h$ Case "BAS" Return C_b$ Case "GAUC" ! he Return C_g$ Case "DROI" ! te Return C_d$ ' Case "CURS" ! eur If Right$(E$,3)<>"OFF" Return Curson$ Else Return Cursoff$ Endif Case "ROUL" ! eau If Right$(E$,3)<>"OFF" Return Roulon$ Else Return Rouloff$ Endif Case "FLAS" ! h If Right$(E$,3)<>"OFF" Return Flash$ Else Return Flashoff$ Endif Case "MASQ" If Right$(E$,3)<>"OFF" Return Mask$ Else Return Maskend$ Endif Case "MONT" ! rer Return Allume$ Case "CACH" ! her Return Eteint$ Case "LINE" If Right$(E$,3)<>"OFF" Return Line$ Else Return Lineoff$ Endif Case "INVE" ! rse If Right$(E$,3)<>"OFF" Return Inverse$ Else Return Inverseoff$ Endif Case "PRO1" Return Pro1$ Case "PRO2" Return Pro2$ Case "PRO3" Return Pro3$ ' Case "ESC[" ! CSI esc + [ + ... Return Esc$+"["+Pr$(0) ' Case "ESC" Return Esc$ Case "SEP" Return Chr$(19) Case "SOH" Return Chr$(1) Case "STX" Return Chr$(2) Case "ETX" Return Chr$(3) Case "EOT" Return Chr$(4) Case "ENQ" Return Chr$(5) Case "ACK" Return Chr$(6) Case "DLE" Return Chr$(16) Case "NAK" Return Chr$(21) Case "SYN" Return Chr$(22) Case "ETB" Return Chr$(23) Case "EM" Return Chr$(25) Case "CSUB" Return Chr$(26) Case "FS" Return Chr$(28) Case "GS" Return Chr$(29) ' Endselect Return "" Endfunc ' ' Vars r‚serv‚es (num) Function Resvaln(E$) Select Left$(E$,4) ' Endselect Return 0 Endfunc ' ' ' ' V A L - S (Val-String) ½ROCHE X. (93) ' Function Evals$(E$) Local A$ ' ~@Vals(Etest!,E$,A$) Return A$ Endfunc ' ' ' index: true= verify, false= not verify Function Vals(Index&,Var T$,Reponse$) $F% Local A%,B%,C%,D%,X%,Str!,Add!,Resultat# Local X$,A$,B$,C$,D$,E$ Local Reponse% Local Pos_loc&,Max_loc& ' Stack_test ! Tester la pile ' ' ---------- Pos_loc&=Pos_e& ! Sauver les index de pile g‚n‚raux Max_loc&=Max_e& ! Add Pos_e&,Max_e&+2 ! On s'en sert! Clr Max_e& ! ' ---------- ' Clr Reponse$ Clr A$ ! string finale Clr Str!,Add! Clr Terrp& A%=1 ! pointeur … 1 (d‚but de la chaine) D%=A% Add!=True ! d‚j… plus .. If Len(T$)>0 Do ' B$=Mid$(T$,A%,1) ! caractŠre courant C$=Mid$(T$,A%+1,1) ! caractŠre suivant D$=Mid$(T$,A%+2,1) ! et le suivant encore If B$=Quote$ ! fin ou d‚but de chaine? ' If Str! ! fin Str!=False Else ! d‚but de chaine ' If Add! ! on a localis‚ d‚j… un '+' ? Str!=True ! d‚but Add!=False ' Else ! il n'y a pas eu de '+' ! If Mid$(T$,A%-1,1)=Quote$ Mid$(T$,A%-1,1)="%" Sub A%,2 Str!=True Else Terr$="'+' obligatoire" Terrp&=A% A%=-1 Exit if True Endif Endif ' Endif ' Else if B$=Quof$ ! %xx ? If Str! ' If C$=Quof$ ! %% Add A%,1 A$=A$+Quof$ Else if C$=Quote$ ! %" = ' Add A%,1 A$=A$+Quote$ ' Else $S& Select C$ ' Case "$" ! var$ ' B%=Asc(Upper$(D$)) If Index&=True Mid$(T$,A%+2,1)=Chr$(B%) ! var Endif If B%=>65 And B%<=90 X$=@Vsval$(Chr$(B%)+"$") ' Else Terr$="variable alpha unique inconnue" Terrp&=A% A%=-1 Exit if True Endif A$=A$+X$ ! on additionne la $var Add A%,2 ! on additionne pour pointeur ' Case "c" ! chr$ B%=Asc(Upper$(D$)) If Index&=True Mid$(T$,A%+2,1)=Chr$(B%) Endif If B%=>65 And B%<=90 X$=Chr$(@Xint(@Vnval(Chr$(B%)))) ' Else Terr$="variable unique inconnue" Terrp&=A% A%=-1 Exit if True Endif A$=A$+X$ Add A%,2 ! on additionne pour pointeur ' Case "&" ! hex$ B%=Asc(Upper$(D$)) If Index&=True Mid$(T$,A%+2,1)=Chr$(B%) ! var Endif If B%=>65 And B%<=90 X$=Hex$(@Xint(@Vnval(Chr$(B%)))) ' Else Terr$="variable unique inconnue" Terrp&=A% A%=-1 Exit if True Endif A$=A$+X$ Add A%,2 ! on additionne pour pointeur ' Case "#" ! str$ B%=Asc(Upper$(D$)) If Index&=True Mid$(T$,A%+2,1)=Chr$(B%) ! var Endif If B%=>65 And B%<=90 X$=Str$(@Vnval(Chr$(B%))) ' Else Terr$="variable unique inconnue" Terrp&=A% A%=-1 Exit if True Endif A$=A$+X$ Add A%,2 ! on additionne pour pointeur ' Case "." A$=A$+Cr$ Add A%,1 ! on additionne pour pointeur Case "*" A$=A$+Bl$+Cr$ Add A%,1 ! on additionne pour pointeur Case "|" A$=A$+Bl$+C_h$+Crt$ Add A%,1 ! on additionne pour pointeur ' Default Terr$="avec les "+Quof$+C$ Terrp&=A% A%=-1 Exit if True ' Endselect $S% Endif ! select ' Else Terr$="les "+Quof$+" doivent etre plac‚s entre des "+Quote$+Quote$ Terrp&=A% A%=-1 Exit if True Endif ' Else If Not Str! ! nous ne sommes pas dans une chaine! ' If Add!=False ! on est sorti de la chaine mais pas encore rentr‚ dans une autre.. $S& Select B$ Case ";","'" ! N'arrive plus avec Strform Mid$(T$,A%,1)="+" ! je pr‚fŠre un '+' Add!=True ! nvelle chaine ' Case "+" ! Add Add!=True ! nvelle chaine ' Case " " ! grrr!... (n'arrive plus avec Strform) If Index&=True T$=Mid$(T$,1,A%-1)+Mid$(T$,A%+1) Dec A% Endif ' Sub A%,2 ' Case "," ! ahhrgh d'autres params (plus avec Strform!) ' Terr$="Trop de paramŠtres ou paramŠtres aprŠs chaine" Terrp&=A% Terrx&=D% A%=Len(T$) ' Default If Instr("-*/\^",B$)<>0 Terr$=B$+" impossible avec chaine!" Terrp&=A% A%=-1 Exit if True Else Terr$=B$+" intranscriptible" Terrp&=A% A%=-1 Exit if True Endif Endselect $S% ' Else ! ADD+TRUE ; on a d‚j… recu un "+" mais on n'est pas dans des '' ' Add!=False ! on est rentr‚ $S& Select B$ ! plus quoi? ( + xx avec xx<>'' ) ' Case " " ! espace.. hum... (no with strform) If Index&=True T$=Mid$(T$,1,A%-1)+Mid$(T$,A%+1) ' Sub A%,2 Dec A% Add!=True Endif ' Case "A" To "Z","$","." ! (pas de "a" ro "z" : Strform!) ' ! Var ou fonction! ' Clr Max_e& ! Restaurer les 2 pointeurs! Pos_e&=Pos_loc&+Max_loc&+2 ' Clr C$ ! Nom Clr D$ ! ParamŠtres Do C$=C$+Mid$(T$,A%,1) Select Mid$(T$,A%+1,1) Case "A" To "Z","0" To "9",".","_" ! var/fonct Inc A% Case "$" ! on saute le '$' Inc A% Default Exit if True Endselect Loop Inc A% ! On pointe sur un "(" ou une op ' Select Mid$(T$,A%,1) Case "(" ! fonction! If Left$(C$,1)="." C$=Mid$(C$,2) Else if Right$(C$,1)="$" Or Right$(C$,1)="." C$=Left$(C$,Len(C$)-1) Endif ' Inc A% ! On pointe sur le 1er char des pars. D$=@Readl$(Mid$(T$,A%)) ! Lire liste Add A%,Len(D$) ! On pointe sur la ) (on espŠre!) If Mid$(T$,A%,1)<>")" Terr$=") manquant" Terrp&=A% Exit if True Endif ' ' Ici on a: le nom (C$) de la fonct et ses params (D$) ' A+1 pointe sur le prochain op (Okay, on touche plus … A%) ' M%=0 Clr X$ X%=0 Do Inc X% X$=@Readp$(Mid$(D$,X%)) Add X%,Len(X$) If Len(X$)>0 Eval$(Pos_e&)=X$ Inc Pos_e& Inc Max_e& Else Exit if True Endif Loop until X%=>Len(D$) Clr X$ Pos_e&=Pos_loc&+Max_loc&+2 ! Restore local ' ' Ici on a la liste Pos_e& et Max_e& ' E$=C$ $S% Select Left$(C$,4) ' Minitel photo Case "PAS" If @Tstcalc("PP") A$=A$+@Pas$(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "PPL" If @Tstcalc("PP") A$=A$+@Ppl$(Eval#(Pos_e&),Eval#(Pos_e&+1)) Endif Case "LI1" If @Tstcalc("S") A$=A$+@Lid$(Eval$(Pos_e&)) Endif Case "LI2" If @Tstcalc("P") A$=A$+@Lij$(Eval#(Pos_e&)) Endif Case "NORM" If @Tstcalc("P") A$=A$+@Norm$(Eval#(Pos_e&)) Endif ' ' ' Conversion de donn‚es Case "BIN" ! Nombre->Binaire If @Tstcalc("Ip") If Max_e&=2 A$=A$+Bin$(Eval#(Pos_e&),Eval#(Pos_e&+1)) Else A$=A$+Bin$(Eval#(Pos_e&)) Endif Endif Case "CHR" ! Ascii->Char If @Tstcalc("I") A$=A$+Chr$(Eval#(Pos_e&)) Endif Case "HEX" ! Nombre->Hexad‚cimal If @Tstcalc("Ip") If Max_e&=2 A$=A$+Hex$(Eval#(Pos_e&),Eval#(Pos_e&+1)) Else A$=A$+Hex$(Eval#(Pos_e&)) Endif Endif Case "OCT" ! Nombre->Octal If @Tstcalc("Ip") If Max_e&=2 A$=A$+Oct$(Eval#(Pos_e&),Eval#(Pos_e&+1)) Else A$=A$+Oct$(Eval#(Pos_e&)) Endif Endif Case "STR" ! Nombre->Chaine If @Tstcalc("Np") If Max_e&=2 A$=A$+Str$(Eval#(Pos_e&),Eval#(Pos_e&+1)) Else A$=A$+Str$(Eval#(Pos_e&)) Endif Endif Case "MKI" If @Tstcalc("I") A$=A$+Mki$(Eval#(Pos_e&)) Endif Case "MKL" If @Tstcalc("I") A$=A$+Mkl$(Eval#(Pos_e&)) Endif Case "MKD" If @Tstcalc("I") A$=A$+Mkd$(Eval#(Pos_e&)) Endif Case "MKS" If @Tstcalc("I") A$=A$+Mks$(Eval#(Pos_e&)) Endif Case "MKF" If @Tstcalc("I") A$=A$+Mkf$(Eval#(Pos_e&)) Endif ' ' Manipulation de chaines de caractŠres Case "LEFT" ! Isoler partie gauche If @Tstcalc("Sp") If Max_e&=2 A$=A$+Left$(Eval$(Pos_e&),Eval#(Pos_e&+1)) Else A$=A$+Left$(Eval$(Pos_e&)) Endif Endif Case "MID","COPY" ! Portion de chaine If @Tstcalc("SPp") If Max_e&=2 A$=A$+Mid$(Eval$(Pos_e&),Eval#(Pos_e&+1)) Else A$=A$+Mid$(Eval$(Pos_e&),Eval#(Pos_e&+1),Eval#(Pos_e&+2)) Endif Endif Case "RIGH" ! Isoler partie droite If @Tstcalc("Sp") If Max_e&=2 A$=A$+Right$(Eval$(Pos_e&),Eval#(Pos_e&+1)) Else A$=A$+Right$(Eval$(Pos_e&)) Endif Endif Case "SPAC" ! Former une chaine d'espaces If @Tstcalc("P") If Eval#(Pos_e&)<32000-Len(A$) A$=A$+Space$(Eval#(Pos_e&)) Else If Not Etest! ! nous ne sommes pas en mode test Terr$="Chaine trop longue max 32000 c." Terrp&=1 A%=-1 Exit if True Else Clr A$ Endif Endif Endif Case "STRI" ! Former une chaine de caractŠres multiples If @Tstcalc("PS") If Eval#(Pos_e&)*Len(Eval$(Pos_e&+1))<32000-Len(A$) A$=A$+String$(Eval#(Pos_e&),Eval$(Pos_e&+1)) Else If Not Etest! ! nous ne sommes pas en mode test Terr$="Chaine trop longue max 32000 c." Terrp&=1 A%=-1 Exit if True Else Clr A$ Endif Endif Endif Case "TRIM" ! Tronquer espaces If @Tstcalc("S") A$=A$+Trim$(Eval$(Pos_e&)) Endif Case "UPPE" ! Minuscules->Majuscules If @Tstcalc("S") A$=A$+Upper$(Eval$(Pos_e&)) Endif ' ' Propre au logiciel - Eval$ Case "PAR" ! Param If @Tstcalc("P") If Eval#(Pos_e&)=>1 And Eval#(Pos_e&)<=10 A$=A$+Proc$(Eval#(Pos_e&)-1) Else If Not Etest! Terr$="ParamŠtre incorrect"+", [1..10] "+"attendu" Terrp&=1 A%=-1 Exit if True Endif Endif Endif Case "VAR" ! Simuler var alphabet (1 lettre) If @Tstcalc("P") If Eval#(Pos_e&)=>1 And Eval#(Pos_e&)<=26 A$=A$+@Vsval$(Chr$(Eval#(Pos_e&)+64)) Else If Not Etest! Terr$="ParamŠtre incorrect"+", [1..26] "+"attendu" Terrp&=1 A%=-1 Exit if True Endif Endif Endif Case "REP" ! Repete (commande vdt) If @Tstcalc("P") If Eval#(Pos_e&)=>1 And Eval#(Pos_e&)<=63 A$=A$+@Repet$(Eval#(Pos_e&)) Else If Not Etest! Terr$="ParamŠtre incorrect"+", [1..63] "+"attendu" Terrp&=1 A%=-1 Exit if True Endif Endif Endif Case "PRO" ! Pro 1,2,3 (vdt) If @Tstcalc("I") If Eval#(Pos_e&)=>1 And Eval#(Pos_e&)<=3 Select Eval#(Pos_e&) Case 1 A$=A$+Pro1$ Case 2 A$=A$+Pro2$ Case 3 A$=A$+Pro3$ Endselect Else If Not Etest! Terr$="ParamŠtre incorrect"+", [1..3] "+"attendu" Terrp&=1 A%=-1 Exit if True Endif Endif Endif Case "BACK","FOND" ! couleur fonc If @Tstcalc("I") If Eval#(Pos_e&)=>0 And Eval#(Pos_e&)<=7 A$=A$+Esc$+Ec$(1,Eval#(Pos_e&)) Else If Not Etest! Terr$="ParamŠtre incorrect"+", [0..7] "+"attendu" Terrp&=1 A%=-1 Exit if True Endif Endif Endif ' Case "TEXT" ! couleur texte If @Tstcalc("I") If Eval#(Pos_e&)=>0 And Eval#(Pos_e&)<=7 A$=A$+Esc$+Ec$(0,Eval#(Pos_e&)) Else If Not Etest! Terr$="ParamŠtre incorrect"+", [0..7] "+"attendu" Terrp&=1 A%=-1 Exit if True Endif Endif Endif ' ' Default Terr$="Fonction chaine inconnue: "+C$ Terrp&=A% ' Endselect Exit if Terrp&<>0 ' Default ! variable! Dec A% ! on recule d'1 pour la fin de boucle! A$=A$+@Vsval$(C$) ! ‚valuer variable! Endselect ' Case "+" Terr$="Un seul '+' suffit!" Terrp&=A% A%=-1 Exit if True ' Default Terr$="Erreur de syntaxe ou caractŠre ill‚gal: "+B$ Terrp&=A% A%=-1 Exit if True ' Endselect $S% ' Endif ' Else ! chaine en cours ' A$=A$+B$ ! on y ajoute ce caractŠre! ' Endif ' Endif ' Inc A% ! Incr‚mentation de A (pointeur de la chaine … calculer) Inc D% Loop until A%>Len(T$) Or Terrp&<>0 ' Else ! Len = 0 Clr Add! Endif ' If Add! Terr$="Plus quoi?" Terrp&=A% A%=-1 Endif If Str! T$=T$+Quote$ Clr A$ Endif ' ' a=-1 => erreur If A%=-1 Clr Reponse$,A$ If Len(Terr$)>0 Terr$="Erreur"+" œ/ "+Terr$ Endif Reponse%=False ' Else ! okay! ' Reponse$=A$ ! renvoi var Clr A$ Reponse%=True Endif ' Pos_e&=Pos_loc& ! Restaurer index de pile du niveau Max_e&=Max_loc& ! sup‚rieur ' Return Reponse% Endfunc ' ' Float->Integer (‚vite les d‚passements de capacit‚!) Function Xint(E#) If E#>&H7FFFFFFF Terr$="Nombre trop grand" Terrp&=1 E#=&H7FFFFFFF Else if E#<&H80000000 Terr$="Nombre trop grand" Terrp&=1 E#=&H80000000 Endif Return E# Endfunc ' ' Fin du source de EVAL ' ½1993 ROCHE Xavier ' ' ' ---------------------------------------- ' ' Important: ' --------- ' A recopier … la suite de Fcalc, dans les Case, et dans evals$ ' SW:EVAL+.LST Fichier LST … ajouter !! ' ' ' ---------------------------------------- ' ' ' Fonctions d'appel Function Analyste(Calc$,Var Message$) Local Reponse# ' Clr Terr$,Terrp& Clr Etest! ! Pas de mode test! Calc$=@Strform$(Calc$) If Terrp&=0 Reponse#=@Calc(Calc$) ! Calculer! Endif Message$=Terr$ Return Reponse# ' Endfunc ' Function Valx(Index&,Var Calc$,Reponse#) $F% ' Etest!=(Index&<>0) If Etest! Calc$=@Strform$(Calc$) Endif If Terrp&=0 Reponse#=@Calc(Calc$) Endif If Terrp&=0 ! Pas d'erreur Return True Else ! Erreur Return False Endif Endfunc ' ' ' Ajouts … Wind tool.. ' Procedure Defmouse(D%) ' If Set_mouse&>-1 If Set_mouse&<1000 Set_mouse&=D% If D%<>2 ~Graf_mouse(D%,0) Else ~Graf_mouse(255,V:M_anim$(0)) Set_mouse&=1000 Endif ' Else ' If D%=2 Inc Set_mouse& If Set_mouse&>1010 Set_mouse&=1000 Endif D%=Set_mouse&-1000 Select D% Case 0 To 9 If Not Even(D%) ~Graf_mouse(255,V:M_anim$(D%\2)) Endif Case 10 ~Graf_mouse(255,V:M_anim$(5)) Endselect D%=2 ' Else Set_mouse&=D% ~Graf_mouse(D%,0) Endif Endif ' Else Defmouse D% ! non install‚ Endif ' Return Procedure Bndary(N&) If Set_boundary&<>N& Contrl(0)=104 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=N& Vdisys Set_boundary&=N& Endif Return ' ' Sp‚c GFA ' $P< Procedure Deftext(C&,T&) If C&<>Act_tcol& Contrl(0)=22 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=C& Vdisys Act_tcol&=C& Endif If T&<>Act_atext& Contrl(0)=106 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=T& Vdisys Act_atext&=T& Endif Return Procedure Deftextcol(C&) If C&<>Act_tcol& Contrl(0)=22 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=C& Vdisys Act_tcol&=C& Endif Return Procedure Deftextattrb(T&) If T&<>Act_atext& Contrl(0)=106 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=T& Vdisys Act_atext&=T& Endif Return Procedure Color(C&) If C&<>Act_col& Contrl(0)=17 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=C& Vdisys Act_col&=C& Endif Return Procedure Graphmode(N&) Contrl(0)=32 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=N& Vdisys Return Procedure Deffill(A&,B&,C&) If A&<>Act_def1& Contrl(0)=25 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=A& Vdisys Act_def1&=A& Endif If B&<>Act_def2& Contrl(0)=23 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=B& Vdisys Act_def2&=B& Endif If C&<>Act_def3& Contrl(0)=24 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=C& Vdisys Act_def3&=C& Endif Return Procedure Deffillcol(A&) If Act_def1&<>A& Contrl(0)=25 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=A& Vdisys Act_def1&=A& Endif Return Procedure Pbox(X&,Y&,X2&,Y2&) Contrl(0)=114 Contrl(1)=2 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=X& Ptsin(1)=Y& Ptsin(2)=X2& Ptsin(3)=Y2& Vdisys Return Procedure Line(X&,Y&,X2&,Y2&) Contrl(0)=6 Contrl(1)=2 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=X& Ptsin(1)=Y& Ptsin(2)=X2& Ptsin(3)=Y2& Vdisys Return Procedure Box(X&,Y&,X2&,Y2&) Contrl(0)=6 Contrl(1)=5 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=X& Ptsin(1)=Y& Ptsin(2)=X2& Ptsin(3)=Y& Ptsin(4)=X2& Ptsin(5)=Y2& Ptsin(6)=X& Ptsin(7)=Y2& Ptsin(8)=X& Ptsin(9)=Y& Vdisys Return ' ' ' Box style GEM Procedure Gbox(X&,Y&,X2&,Y2&) @Xgbox(X&,Y&,X2&,Y2&) @Bndary(0) Gosub Deffillcol(0) Gosub Pbox(X&,Y&,X2&,Y2&) Gosub Deffillcol(Colg&) @Bndary(1) Return ' Procedure Xgbox(X&,Y&,X2&,Y2&) If Adr%(32)>0 Ob_x(Adr%(32),0)=X&-1 Ob_y(Adr%(32),0)=Y&-1 Ob_w(Adr%(32),0)=X2&-X&+2 Ob_h(Adr%(32),0)=Y2&-Y&+2 If Clip_x&=>0 ~Objc_draw(Adr%(32),0,7,Clip_x&,Clip_y&,Clip_w&,Clip_h&) Else ~Objc_draw(Adr%(32),0,7,Max(X&,0),Max(Y&,0),Min(Work_out(0),X2&-X&+1),Min(Work_out(1),Y2&-Y&+1)) Endif Else Gosub Deffillcol(0) Gosub Pbox(X&,Y&,X2&,Y2&) Gosub Deffillcol(Colg&) Endif Return ' Procedure Clip(X&,Y&,W&,H&) Clip_x&=Max(X&,0) Clip_y&=Max(Y&,0) Clip_w&=Min(W&,Work_out(0)-X&+1) Clip_h&=Min(H&,Work_out(1)-Y&+1) Clip Clip_x&,Clip_y&,Clip_w&,Clip_h& Return Procedure Clip_off ' Clip Off Clip_x&=-1 Clip X_desk&,Y_desk&,W_desk&,H_desk& Return Procedure Reclip If Clip_x&=>0 Clip Clip_x&,Clip_y&,Clip_w&,Clip_h& Endif Return Procedure Wind_clip(Index&) Local Rx&,Ry&,Rw&,Rh& ' Rx&=X_desk& Ry&=Y_desk& Rw&=W_desk& Rh&=H_desk& If Rc_intersect(W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&),Rx&,Ry&,Rw&,Rh&) Clip(W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) Endif Return $P> ' ' Get/Put VDI ' WARNING: Ne jamais modifier le paramŠtre "linea!" en cours de programme, ' -------- pour ‚viter tout problŠme (bombes, plantages, resetS, etc etc.....) ' Procedure Getplane ' If Linea! ! si … -1 alors pr‚sente real?4 If Bclr(@Bios11,4)<>0 If @Form_alert(0,"[3][Accepter la ligne A? |('line A')|Pour une meilleure |compatibilit‚, ‚viter la lineA|peut ˆtre n‚cessaire][ Oui | Non ]")=2 Linea!=False Else Linea!=True Endif Endif ' LineA pr‚sente? Select L~a ! Case 0,-1,1 Linea!=False ! LineA absente? Default If Even(L~a) And L~a<32000 And L~a>2048 ! Adresse possible?.. If Word(Dpeek(L~a+34))=-1 ! doit contenir -1 Linea!=True ! LineA pr‚sente Else Linea!=False ! LineA absente? Endif Else Linea!=False ! LineA absente? Endif Endselect Endif ! sinon on en veut pas! ' Plans&=Work_out(13) ! Nb de couleurs utilisables If Plans&=0 Nbr_c%=Work_out(39) ! Nb de couleurs max? If Nbr_c%<=&X10 Plans&=1 ! 1 octet: mono (??) Else if Nbr_c%<=&H100 Plans&=8 ! 1 octet: 256c Else if Nbr_c%<=&H10000 Plans&=16 ! 2 octets: 32/64Kcouleurs. Else if Nbr_c%<=&H1000000 Plans&=24 ! 3 octets: 16Mcouleurs. Else Plans&=32 Endif Else Select Plans& Case 2 ! mono Plans&=1 Case 4 ! 4col Plans&=2 Case 16 ! 16col Plans&=4 Case 256 ! 256col? Nbr_c%=Xbios(88,-1) ! 256c ou TC? (Xbios88) Nbr_c%=And(Nbr_c%,&X111) If Nbr_c%=&X100 Plans&=16 ! True color Else Plans&=8 ! 256c Endif Case 32768 Plans&=16 ! 32/65Kc Default Plans&=24 ! 16Mc? Endselect Endif ' W_gdesk%=Work_out(0)+1 H_gdesk%=Work_out(1)+1 Set_putmode&=3 ! mode ‚criture 3 (replace) ' Return ' ' ' Get/Put Procedure Get(X&,Y&,X2&,Y2&,Var G$) ' @Lhidem If Linea! ! youpi Get X&,Y&,X2&,Y2&,G$ ! tout betement ' Else ! alors on passe par VDI RASTER COPY FORM / OPAQUE ' Gd_w&=X2&-X&+1 Gd_h&=Y2&-Y&+1 ' If scr_adr%<>0 And Even(scr_adr%) And Y&+gd_h&0 And gd_h&>0 If Y&+Gd_h&<=H_gdesk% And Gd_w&>0 And Gd_h&>0 ' If Mod(Gd_w&,16)=0 Gd_l%=Gd_w& ! Nb de points Else Gd_l%=(Gd_w&\16+1)*16 Endif Gd_l%=Gd_l%*Gd_h& ' Gd_l%=Gd_l%*Plans& ! *Nb de plans=Nb de bits Gd_l%=Gd_l%\8 ! \8=nb d'octets Gd_l%=Gd_l%+4 ! +4 (dim) If Gd_l%<&H8000 G$=String$(Gd_l%,0) ' ' G_s%(0)=&H0 G_s%(1)=Gd_w& G_s%(2)=Gd_h& If Mod(Gd_w&,16)=0 G_s%(3)=Gd_w&\16 Else G_s%(3)=Gd_w&\16+1 Endif G_s%(4)=0 G_s%(5)=Plans& ' R_d%(0)=X& R_d%(1)=Y& R_d%(2)=X&+Gd_w&-1 R_d%(3)=Y&+Gd_h&-1 R_d%(4)=0 R_d%(5)=0 R_d%(6)=Gd_w&-1 R_d%(7)=Gd_h&-1 R_d%(8)=3 ' ' Void Fre(0) ! trop lent! G_s%(0)=Varptr(G$)+4 ! placer adresse Bitblt G_screen%(),G_s%(),R_d%() ! Vdi Raster Copy ; Opaque Mid$(G$,1,2)=Mki$(Gd_w&) ! sauver w et h Mid$(G$,3,2)=Mki$(Gd_h&) Else ' d‚passement des limites de l'‚cran ' Endif Endif Endif ! fin test line~a @Lshowm ' Return Procedure Put(X&,Y&,G$) ' @Lhidem If Linea! ! youpi Put X&,Y&,G$,Set_putmode& ! tout bˆtement ' Else ! alors on passe par VDI RASTER COPY FORM / OPAQUE Gd_w&=Dpeek(Varptr(G$)) ! r‚cup‚rer w et h Gd_h&=Dpeek(Varptr(G$)+2) ' If And(scr_adr%<>0,Y&+gd_h&0 Inc G_s%(3) Endif G_s%(4)=0 G_s%(5)=Plans& ' R_d%(4)=X& ! idem R_d%(5)=Y& R_d%(6)=X&+Gd_w&-1 R_d%(7)=Y&+Gd_h&-1 R_d%(0)=0 R_d%(1)=0 R_d%(2)=Gd_w&-1 R_d%(3)=Gd_h&-1 R_d%(8)=Set_putmode& ! mode gr ' ' Void Fre(0) G_s%(0)=Varptr(G$)+4 ! placer adresse Bitblt G_s%(),G_screen%(),R_d%() ! Vdi Raster Copy ; Opaque ' Else ' d‚passement des limites de l'‚cran Gosub Deffillcol(0) Gosub Pbox(X&,Y&,X&+Gd_w&,Y&+Gd_h&) Endif Endif ! fin test line~a @Lshowm ' Return ' Function Bitlen(W&,H&) ' If Mod(W&,16)=0 Gd_l%=W& ! Nb de points Else Gd_l%=(W&\16+1)*16 Endif Gd_l%=Gd_l%*H& Gd_l%=Gd_l%*Plans& ! *Nb de plans=Nb de bits Gd_l%=Gd_l%\8 ! \8=nb d'octets Gd_l%=Gd_l%+4 ! Descripteur m‚moire ' Return Gd_l% Endfunc ' ' ' Get/Put avec adresse - optimis‚ pour ‚mulateur Procedure Cget(X&,Y&,Adr%) ' @Lhidem ' ' If scr_adr%<>0 And Even(scr_adr%) And Y&+gd_h&0 And gd_h&>0 If Y&+Cachey&<=H_gdesk% And Cachex&>0 And Cachey&>0 ' G_s%(0)=Adr% ! placer adresse G_s%(1)=Cachex& G_s%(2)=Cachey& If Mod(Cachex&,16)=0 G_s%(3)=Cachex&\16 Else G_s%(3)=Cachex&\16+1 Endif G_s%(4)=0 G_s%(5)=Plans& ' R_d%(0)=X& R_d%(1)=Y& R_d%(2)=X&+Cachex&-1 R_d%(3)=Y&+Cachey&-1 R_d%(4)=0 R_d%(5)=0 R_d%(6)=Cachex&-1 R_d%(7)=Cachey&-1 R_d%(8)=3 ' Bitblt G_screen%(),G_s%(),R_d%() ! Vdi Raster Copy ; Opaque Endif @Lshowm ' Return Procedure Cput(X&,Y&,Adr%) ' @Lhidem ' If And(scr_adr%<>0,Y&+gd_h&0 Inc G_s%(3) Endif G_s%(4)=0 G_s%(5)=Plans& ' R_d%(4)=X& ! idem R_d%(5)=Y& R_d%(6)=X&+Cachex&-1 R_d%(7)=Y&+Cachey&-1 R_d%(0)=0 R_d%(1)=0 R_d%(2)=Cachex&-1 R_d%(3)=Cachey&-1 R_d%(8)=Set_putmode& ! mode gr ' Bitblt G_s%(),G_screen%(),R_d%() ! Vdi Raster Copy ; Opaque ' Else ' d‚passement des limites de l'‚cran Gosub Deffillcol(0) Gosub Pbox(X&,Y&,X&+Word{Adr%},Y&+Word{Adr%+2}) Endif @Lshowm ' Return ' ' ' ' Addresse Get/Put Procedure Aget(X&,Y&,W&,H&,Var Set_adr%) ' If Set_adr%>0 ~@Mfree(Set_adr%) Set_adr%=-1 Endif ' W&=Min(Work_out(0)-X&-1,W&) H&=Min(Work_out(1)-Y&-1,H&) ' @Lhidem ' If scr_adr%>0 And Y&+H&0 And H&>0 If Y&+H&<=H_gdesk% And W&>0 And H&>0 ' If Mod(W&,16)=0 Gd_l%=W& ! Nb de points Else Gd_l%=(W&\16+1)*16 ! Nb de points Endif Gd_l%=Gd_l%*H& Gd_l%=Gd_l%*Plans& ! *Nb de plans=Nb de bits Gd_l%=Gd_l%\8 ! \8=nb d'octets Add Gd_l%,4 ! +4=Header Add Gd_l%,8 ! +8=S‚curit‚ ' Set_adr%=@Malloc(Gd_l%) ' If Set_adr%>0 ' ' G_s%(0)=&H0 G_s%(1)=W& G_s%(2)=H& If Mod(W&,16)=0 G_s%(3)=W&\16 Else G_s%(3)=1+(W&\16) Endif G_s%(4)=0 G_s%(5)=Plans& ' R_d%(0)=X& R_d%(1)=Y& R_d%(2)=X&+W&-1 R_d%(3)=Y&+H&-1 R_d%(4)=0 R_d%(5)=0 R_d%(6)=W&-1 R_d%(7)=H&-1 R_d%(8)=3 ' G_s%(0)=Set_adr%+4 ! placer adresse Bitblt G_screen%(),G_s%(),R_d%() ! Vdi Raster Copy ; Opaque Word{Set_adr%}=W& ! sauver w et h Word{Set_adr%+2}=H& Else Set_adr%=-1 ! Error! Endif ' Else ' d‚passement des limites de l'‚cran ' Endif @Lshowm Return Procedure Aput(X&,Y&,Set_adr%) ' Local W&,H& ' If Set_adr%>0 @Lhidem Gd_w&=Word{Set_adr%} ! r‚cup‚rer w et h Gd_h&=Word{Set_adr%+2} Gd_w&=Min(Work_out(0)-X&-1,Gd_w&) Gd_h&=Min(Work_out(1)-Y&-1,Gd_h&) ' If And(scr_adr%<>0,Y&+gd_h&0 Inc G_s%(3) Endif G_s%(4)=0 G_s%(5)=Plans& ' R_d%(4)=X& ! idem R_d%(5)=Y& R_d%(6)=X&+Gd_w&-1 R_d%(7)=Y&+Gd_h&-1 R_d%(0)=0 R_d%(1)=0 R_d%(2)=Gd_w&-1 R_d%(3)=Gd_h&-1 R_d%(8)=Set_putmode& ! mode gr ' G_s%(0)=Set_adr%+4 ! placer adresse Bitblt G_s%(),G_screen%(),R_d%() ! Vdi Raster Copy ; Opaque ' Else ' d‚passement des limites de l'‚cran Gosub Deffillcol(0) Gosub Pbox(X&,Y&,X&+Gd_w&,Y&+Gd_h&) Endif @Lshowm Endif ' Return ' ' ' Renvoi True si le mode text actuel est r‚gulier (Ccsize[x/y]) Function Testex Local A% ' Contrl(0)=116 ! Inquire text extend Contrl(1)=0 Contrl(3)=32 Contrl(6)=V~h For A%=0 To 31 Intin(A%)=65 Next A% Vdisys Return (Ptsout(4)\32)*32=Ptsout(4) ' Endfunc ' ' Renvoi la longueur de E$ en points Function Textlen(E$) Local A% ' Contrl(0)=116 ! Inquire text extend Contrl(1)=0 Contrl(3)=Len(E$) Contrl(6)=V~h For A%=0 To Len(E$)-1 Intin(A%)=Asc(Mid$(E$,A%+1,1)) Next A% Vdisys Return Ptsout(4) ' Endfunc ' ' ' ..Mode%= On cherche: ' 0 Largeur ' 1 Hauteur ' 2 Largeur+Hauteur ' Function Text_size_find(W&,H&,Mode%) Local A&,N&,I&,P& ' N&=-1 ! derniŠre taille choisie P&=W&+H& ! Coef de performance (points de diff‚rence W+H) For A&=0 To 199 ' Contrl(0)=12 ! set character height Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(1)=A& Vdisys ' Select Mode% Case 0 I&=Abs(Ptsout(2)-W&) Case 1 I&=Abs(Ptsout(3)-H&) Case 2 I&=Abs(Ptsout(2)-W&)+Abs(Ptsout(3)-H&) Endselect ' ' If I&-1 Contrl(0)=12 ! set character height Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(1)=N& Vdisys Endif ' Return N& Endfunc ' ' ' ' A$="A:\" B$="*.*" Function Fsel$(A$,B$,Info$) Local C$,File$,A%,B% ' @Showm If Dim?(Whandle&()) Gosub Menu.info(Info$) ! info Endif ' A$=Trim$(Upper$(A$)) B$=Trim$(Upper$(B$)) ' If Left$(A$,1)="\" ! mettre lecteur! A$=Chr$(Gemdos(25)+65)+":"+A$ Endif ' If Instr(B$,"\") ! nom d‚fault avec chemin? alors modifier chemin! If Instr(A$,"\") C$=Right$(A$,Len(A$)-Rinstr(A$,"\")) Endif A$=Left$(B$,Rinstr(B$,"\"))+C$ B$=Right$(B$,Len(B$)-Rinstr(B$,"\")) Endif B$=Left$(B$,12) ' If Len(A$)=0 A$=Chr$(Gemdos(25)+65)+":\*.*" Endif ' attention … l'ordre des params ~@Wind_update01(1) A%=@Fsel_exinput(Info$,A$,B$,B%) ~@Wind_update01(0) If A%<>0 ' If B%=0 Clr File$ ' Else ' If Len(A$)<>0 A%=Rinstr(A$,"\") If A%<>0 File$=B$ If Rinstr(File$,".")=0 If Rinstr(A$,".")<>0 If Mid$(A$,Rinstr(A$,".")+1,1)<>"*" File$=File$+Mid$(A$,Rinstr(A$,".")) Endif Endif Else if Mid$(File$,Rinstr(File$,"."))="." If Rinstr(A$,".")<>0 If Mid$(A$,Rinstr(A$,".")+1,1)<>"*" File$=File$+Mid$(A$,Rinstr(A$,".")+1) Endif Endif Endif ' A$=Mid$(A$,1,A%) File$=A$+File$ Else Clr File$ Endif ' Else Clr File$ Endif ' Endif ' Else Clr File$ Endif ' ' lecteur courant? Select Upper$(Left$(File$,1)) Case "A" To "Z" If @Exist(Upper$(Left$(File$,1))+":\*.*") Chdrive Upper$(Left$(File$,1)) Endif Endselect A%=Rinstr(File$,"\") If A%>0 If (Fsfirst(Left$(File$,A%),0)=>0) Chdir Left$(File$,A%) Endif Endif ' Return File$ Endfunc ' Fileselect 1.4 Function Fsel_exinput(Info$,Var A$,B$,B%) $F% Local A% ' A%=Lpeek(&H4F2) ! SYSbase If A%<>0 ! adresse correcte? Add A%,2 ! offset + 2 = TOSversion A%=Dpeek(A%) ! version TOS If A%=>&H104 ! tos 1.4 ? A%=True ! youpi Else ! old tos A%=False Endif Else A%=False ! adresse incorrecte?? Endif ' If A%=True ! new tos? ' A ne pas oublier!! A$=A$+Mki$(0) B$=B$+Mki$(0) Info$=Info$+Mki$(0) ' A$=A$+String$(255-Len(A$),0) ! retour (255o. sont suffisants!!) B$=B$+String$(14-Len(B$),0) ! (place) ' Void Fre(0) Gcontrl(0)=91 ! fonction 90 (+ex) Gcontrl(1)=0 ! nb param int_in (aucun) Gcontrl(3)=4 ! nb param addr_in (3 string$+1 adr retour) Addrin(0)=Varptr(A$) ! param $ Addrin(1)=Varptr(B$) ! '' idem Addrin(2)=Varptr(Info$) ! '' idem Gemsys 91 ! appel AES ' A$=Left$(A$,Instr(A$,Chr$(0))-1) ! params de B$=Left$(B$,Instr(B$,Chr$(0))-1) ! retour ' B%=Gintout(1) Return Gintout(0) ' Else ! old tos? Return Fsel_input(A$,B$,B%) Endif ' Endfunc ' ' nouvelle fnction exist Function Exist(A$) $F% Return (Fsfirst(A$,0)=>0) Endfunc ' ' A$="XXXXXXXX.XXX" Function Fexist(Var A$) $F% If Left$(A$,1)="\" A$=Chr$(Gemdos(25)+65)+":"+A$ Endif If Fsfirst(A$,0)<0 If Fsfirst("\"+A$,0)=>0 A$="\"+A$ Return True Else if Fsfirst(Set_path$+A$,0)=>0 A$=Set_path$+A$ Return True Endif Else Return True Endif Return False Endfunc ' ' ' Procedure Kill(A$) ' Local E% ' ' A$=A$+Chr$(0) ' E%=Gemdos(65,L:Varptr(A$)) ' If E%<0 ' ~@Form_alert(1,@Errf$(E%)) ' Endif ' Return ' backup TRUE=OK Function Back(E$) $F% Local A%,A$,E% ' If Len(E$)>0 ~@Wind_update01(0) If @Exist(E$) ' A%=Rinstr(E$,".") If A%=0 A$=E$+".BAK" Else A$=Mid$(E$,1,A%)+"BAK" Endif A$=A$+Chr$(0) E$=E$+Chr$(0) If @Exist(A$) ' Kill A$ E%=Gemdos(65,L:Varptr(A$)) If E%<0 ~@Form_alert(1,@Errf$(E%)) Gosub Comm.info("G","*Erreur #"+Str$(E%)) Return False Endif Endif ' Name E$ As A$ E%=Gemdos(86,0,L:Varptr(E$),L:Varptr(A$)) If E%<0 ~@Form_alert(1,@Errf$(E%)) Gosub Comm.info("G","*Erreur #"+Str$(E%)) Return False Endif ' Else Return False Endif Endif ' Return True Endfunc ' ' Procedure: initialisation des @Errf$() Procedure Errstr Local A%,A$ Dim Errp$(115) Dim Errn$(70) ' Errn$(67)="* Erreur de bloc m‚moire" Errn$(66)="* Ce n'est pas|un fichier binaire|-Erreur de format-" Errn$(65)="* Erreur interne de GEMDOS|-Erreur g‚n‚rale-" Errn$(64)="* Erreur GEMDOS|seek incorrect" Errn$(49)="* Il n'y a pas d'autres donn‚es" Errn$(46)="* Num‚ro de lecteur incorrect" Errn$(40)="* Adresse de bloc m‚moire|incorrecte" Errn$(39)="* M‚moire pleine|Plus de blocs" Errn$(37)="* Handle incorrect|Erreur de fichier" Errn$(36)="* AccŠs impossible|Erreur p‚riph‚rique " Errn$(35)="* Trop de fichiers ouverts" Errn$(34)="* Nom de chemin introuvable|dans directory" Errn$(33)="* Fichier introuvable ou absent" Errn$(32)="* Num‚ro de fonction incorrect" Errn$(17)="* Ins‚rer une autre disquette" Errn$(16)="* Mauvais secteur (Verify)" Errn$(15)="* Appareil inconnu" Errn$(14)="* Vous avez chang‚ de disquette" Errn$(13)="* Disquette prot‚g‚e |contre l'‚criture|(impossible d'‚crire)" Errn$(12)="* Erreur g‚n‚rale 12" Errn$(11)="* Erreur de lecture" Errn$(10)="* Erreur d'‚criture" Errn$(9)="* Pas de papier |ou pas d'imprimante" Errn$(8)="* Secteur introuvable|Pas de disquette|ou disque endommag‚" Errn$(7)="* Unknown Media|mauvais bootsecteur|Disque endommag‚" Errn$(6)="* Seek Error|piste introuvable|Pas de disquette|ou disque endommag‚" Errn$(5)="* Bad Request|instruction ne convenant pas" Errn$(4)="* Erreur CRC - test de somme|du disque incorrect" Errn$(3)="* Instruction inconnue" Errn$(2)="* Drive not Ready|d‚synchronisation" Errn$(1)="* Erreur g‚n‚rale ou erreur |inconnue" Errp$(0)="Division par z‚ro d‚tect‚e" Errp$(1)="D‚passement de capacit‚|Erreur math‚matique overflow|(trop grand)" Errp$(2)="Le nombre n'est pas un Integer|-2147483648 .. 2147483647" Errp$(3)="Le nombre n'est pas un octet|0 .. 255" Errp$(4)="Le nombre n'est pas un mot|-32768 .. 32767" Errp$(5)="Racine carr‚e d'un nombre|n‚gatif impossible" Errp$(6)="Logarithme d'un nombre|inf‚rieur … z‚ro impossible" Errp$(8)="M‚moire pleine |ou d‚passement de capacit‚" Errp$(9)="Fonction ou instruction|impossible" Errp$(10)="Chaine trop longue|max 32767 caractŠres|Memoire ou buffer plein" ' Errp$(11)="Le programme n'est pas|en GFA BASIC 3.0" Errp$(12)="Programme trop grand|m‚moire pleine" ' Errp$(13)="Le fichier programme|n'est pas en GFA BASIC" Errp$(14)="Champ dimensionn‚ deux fois" Errp$(15)="Champ non dimensionn‚" Errp$(16)="Index de champ trop grand" Errp$(17)="Index de dim trop grand" ' Errp$(18)="Mauvais nombre d'indices" ' Errp$(19)="Proc‚dure introuvable" ' Errp$(20)="Marque introuvable" ' Errp$(21)="Pour OPEN utiliser|'I'nput 'O'utput 'R'andom|'A'ppend 'U'pdate" Errp$(22)="Fichier d‚j… ouvert" Errp$(23)="Mauvais num‚ro de fichier" Errp$(24)="Fichier non ouvert" Errp$(25)="Mauvaise saisie|Ce n'est pas un nombre" Errp$(26)="Fin de fichier atteinte|EOF" Errp$(27)="Trop de points pour|Polyline/fill/mark|max 128" Errp$(28)="Le champ ne peut avoir|qu'une dimension" Errp$(29)=Ÿî]#½!âiœÞtrmsœÞtype de tramage!ÉÈ f -2 si erreTrace$ Offset Mki$( With Mkf$()Mks$(Mkf$()Round(Trace$Cvs(Cfloat(Bin$(Bin$(:Round( As Min(Bin$()Deg( With Char{Cfloat(Mks$()Round(Min(Mkf$() As Mkf$()Mkl$(Rad(Char{ Offset Round( ' Errp$(30)="Merge, ce n'est pas|un fichier ASCII" ' Errp$(31)="Merge, ligne trop longue" Errp$(32)="==> Syntaxe incorrecte|arrŠt du programme" ' Errp$(33)="Marque non d‚finie" Errp$(34)="Trop peu de donn‚es" Errp$(35)="Donn‚e non num‚rique,|format incorrect|ou donn‚es absurdes" ' Errp$(36)="Erreur de syntaxe dans la|donn‚e, utiliser les ''|par paires" Errp$(37)="Disquette ou disque plein" ' Errp$(38)="Instruction impossible|en mode direct" ' Errp$(39)="Erreur de programmation|GOSUB impossible" ' Errp$(40)="CLEAR n'est pas possible dans|une boucle FOR NEXT|ou une proc‚dure" Errp$(41)="CONT impossible" Errp$(42)="Trop peu de paramŠtres" Errp$(43)="Expression trop complexe" Errp$(44)="Fonction ind‚finie" Errp$(45)="Trop de paramŠtres" Errp$(46)="ParamŠtre inexact|ce doit ˆtre un nombre" Errp$(47)="ParamŠtre inexact|ce doit ˆtre une chaine" Errp$(48)="Open 'R'|Enregistrement trop long" Errp$(49)="Trop de fichiers 'R'" Errp$(50)="Pas de fichier 'R'" Errp$(52)="Champ plus grand|que l'enregistrement" Errp$(54)="Mauvaise longueur|d'enregistrement GET/PUT" Errp$(55)="Mauvais num‚ro|de phrase GET/PUT" Errp$(60)="Longueur de chaŒne|de SPRITE erron‚e" Errp$(61)="RESERVE Erreur|Erreur m‚moire" Errp$(62)="Erreur dans Menu" Errp$(63)="Erreur dans Reserve" Errp$(64)="Erreur dans pointeur" Errp$(65)="Champ <256" Errp$(66)="VAR-champ ?" Errp$(67)="Erreur ASIN/ACOS" Errp$(68)="VAR unpaired" Errp$(69)="ENDFUNC sans RETURN" Errp$(71)="Index trop grand" Errp$(90)="Erreur dans Local" Errp$(91)="Erreur dans For" Errp$(92)="Resume (next) impossible|fatal, For ou Local" Errp$(93)="Stack Erreur" ' Errp$(100)="GFA-BASIC Version 3 |½ Copyright 1986-1989|GFA Systemtechnik GmbH" Errp$(102)="2 bombes - erreur bus|peut-ˆtre mauvais Peek ou Poke" Errp$(103)="3 bombes - erreur d'adresse|adresse de mot impaire|avec Dpoke, Dpeek, Lpoke|ou Lpeek?" Errp$(104)="4 bombes - ex‚cution d'une|instruction 68000|ne convenant pas" Errp$(105)="5 bombes - division par z‚ro|en langage machine 68000|" Errp$(106)="6 bombes - exception CHK|interruption 68000|par instruction CHK" Errp$(107)="7 bombes - exception TRAPV|interruption 68000|par instruction TRAPV" Errp$(108)="8 bombes - interruption 68000|par ex‚cution d'une|instruction privil‚gi‚e" Errp$(109)="9 bombes - exception trace|interruption trace avec 68000" Errp$(110)="10 bombes - ligne $a" Errp$(111)="11 bombes - ligne $f" Errp$(113)="13 bombes - 68030|violation coprocesseur" Errp$(114)="14 bombes - 68010|erreur de format" Errp$(115)="15 bombes - vecteur interrupt." Return ' Fonction: Message d'erreur. Function Errf$(A%) Local A$ ' A%=Word(A%) If Dim?(Errp$())<>0 And Dim?(Errn$())<>0 If A%=>-67 And A%<=115 If A%=>0 A$="[3]["+Errp$(A%)+"][Return]" If A$="[3][][Return]" A$="[3][|Erreur #"+Str$(A%)+"][Return]" Endif Else A%=-A% A$="[3]["+Errn$(A%)+"][Return]" If A$="[3][][Return]" A$="[3][|Erreur #"+Str$(A%)+"][Return]" Endif Endif Else A$="[3][Erreur #"+Str$(A%)+"][Return]" Endif Else A$=Err$(A%) Endif Return A$ Endfunc ' Procedure Helpme(E$) Local N% ' N%=Instr(E$,Chr$(32)) If N%>1 E$=Left$(E$,N%-1) E$=Trim$(Upper$(E$)) If Len(E$)>0 Clr N% While (Instr$(N%,0)<>E$) Inc N% If Len(Instr$(N%,0))=0 N%=-1 Exit if True Endif Wend If N%<>-1 E$=@Linehelp$(N%) Gosub Menu.info(E$) Endif Endif Endif ' Return ' Function Linehelp$(A%) Local B%,T$ ' Clr T$ T$=Instr$(A%,0) B%=0 Repeat ' ' paramx: 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc If Instr&(A%,B%)>0 If B%<>0 T$=T$+"," Else T$=T$+Chr$(32) Endif ' T$=T$+"[" Select Instr&(A%,B%) ' Case 1 T$=T$+"On/Off" Case 2 T$=T$+"Byte" Case 3 T$=T$+"Valeur" Case 4 T$=T$+"String" Case 5 T$=T$+"Var" Case 6 T$=T$+"Var$" Case 7 T$=T$+"Couleur" Case 8 T$=T$+"1..63" Case 9 T$=T$+"Nom" Default T$=T$+"????" ' Endselect T$=T$+"]" ' Else B%=-1 Endif ' If B%<>-1 Inc B% Endif Until B%>Dinstr& Or B%=-1 ' T$=T$+" : " Select Tpi|(A%) Case 0 T$=T$+"Fonction graphique" Case 1 T$=T$+"Commande:" Case 2 T$=T$+"Info" Case 3 T$=T$+"Gestion vars" Case 4 T$=T$+"Ifs/Conds" Case 5 T$=T$+"Boucles" Case 6 T$=T$+"CaractŠre de commande/sp‚cial" Endselect ' T$=T$+" {" For B%=1 To 2 If B%=2 T$=T$+"," Endif T$=T$+Instr$(A%,B%) Next B% T$=T$+"}" ' Return T$ Endfunc ' ' Function Qlhelp$(A%,C|) ! help de instr_a ; partie C| Local B%,T$ ' Clr T$ Select C| Case 1 T$=Instr$(A%,0) T$=T$+Space$(Max(1,$ And And And And Eqv Xor -Len(T$))) Case 2 B%=0 Repeat ' ' paramx: 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc If Instr&(A%,B%)>0 If B%<>0 T$=T$+"," Else ' T$=T$+Chr$(32) Endif ' T$=T$+"[" Select Instr&(A%,B%) ' Case 1 T$=T$+"On/Off" Case 2 T$=T$+"Byte" Case 3 T$=T$+"Valeur" Case 4 T$=T$+"String" Case 5 T$=T$+"Var" Case 6 T$=T$+"Var$" Case 7 T$=T$+"Couleur" Case 8 T$=T$+"1..63" Case 9 T$=T$+"Nom" Default T$=T$+"????" ' Endselect T$=T$+"]" ' Else B%=-1 Endif ' If B%<>-1 Inc B% Endif Until B%>Dinstr& Or B%=-1 ' Case 3 T$="{" For B%=1 To 2 If B%=2 T$=T$+"," Endif T$=T$+Instr$(A%,B%) Next B% T$=T$+"}" Endselect ' Return T$ Endfunc ' ' Help procedure, a: touche … aider Procedure Help(Index&,Var N&) Local X% Local A$ ' Clr X%,A$ If Help! ' | | | Select N& Case -226 ' | | | A$=A$+"Un message comme celui ci vous|demandera de confirmer chaque|" A$=A$+"op‚ration par la suite." Clr N& X%=True Case -1,-3 If N&=-3 ' | | | A$=A$+"La compilation a ‚t‚ arrˆt‚e..|R‚-ouvrez "+Name$+", puis| |" A$=A$+"relancez-la" X%=@Form_alert(1,"[3]["+A$+"][Continuer ]") Clr A$ Endif A$=A$+Name$+" a d– ˆtre ferm‚ pour |cause du lancement d'une autre|" A$=A$+"application ou d'une erreur |systŠme. Votre source n'est|" A$=A$+"heuresement pas perdu." Clr N& X%=True Case -2 A$=A$+Name$+" a d– ˆtre ferm‚ pour |cause d'une erreur systŠme...|" If Edited!(0) A$=A$+"Votre source a ‚t‚ perdu" Else A$=A$+"Votre source n'a heuresement|pas ‚t‚ perdu" Endif Clr N& X%=True ' Case -5 ! XMove ' | | | A$=A$+"D‚placement graphique: |" A$=A$+"Alt U,D: «fenˆtre haut,bas |Contrl "+Mki$(&H304)+": «fenˆtre droite,g |" A$=A$+"Shift "+Mkl$(&H1020304)+": d‚placer de |1 pixel (d‚placement fin)" Clr N& X%=True ' Case 226 A$=A$+"Aide dynamique |"+Name$+Chr$(32)+Release$+"|D‚sactiver: |cliquer sur CONTINUER" Clr N& Case 14 A$=A$+"Changer de fenˆtre |(fenˆtre suivante)" Clr N& X%=True Case 6 A$=A$+"Plein ‚cran/normal |(fenˆtre)" Clr N& X%=True ' Case "?","!" ' A$=A$+"Bah pourquoi?" ' Clr N& ' X%=True Endselect ' If Index&=4 ' ' | | | Select N& ' Case 177 A$=A$+"R‚initialiser les paramŠtres |par d‚faut dans l'‚mulateur" Case 174 A$=A$+"R‚gler les options du cache |vid‚otex (taille) en caractŠres" Case 147 If Redir!=False A$=A$+"Si vous ne poss‚dez pas de |minitel, cette op‚ration |" A$=A$+"vous permet de le remplacer |par l'‚mulateur" Else A$=A$+"D‚sactiver l'‚mulateur et |diriger les prochains |" A$=A$+"caractŠres vers le minitel" Endif Case 167 A$=A$+"Choisir les couleurs et les |motifs pour l'‚mulation" ' Endselect ' ' Else if Index&=2 ' | | | Select N& Case "L" A$=A$+"CHARGER un graphique vers |l'‚diteur graphique|" A$=A$+"(*.EGR)" Case "S" A$=A$+"SAUVER le graphique de |l'‚diteur sur disque|" A$=A$+"Attention, format propre … |"+Name$+" (<>Vid‚otex)|" A$=A$+"(*.EGR)" Case "E" A$=A$+"Effacer le graphique actuel |(Page blanche)" Case 146 A$=A$+"Effacer le graphique actuel et|le remplir en noir (ou blanc?)|" Case 18 A$=A$+"Redessiner la fenˆtre! |(Redraw)" Case 71 If Coord! A$=A$+"Ne plus afficher coordonn‚es|de la souris et la loupe dans|" A$=A$+"l'‚diteur graphique" Else A$=A$+"Afficher les coordonn‚es |de la souris et la loupe dans|" A$=A$+"l'‚diteur graphique" Endif Case 225 A$=A$+"Annule la derniŠre op‚ration |dans l'‚diteur" Case "I" A$=A$+"Inverser le graphique, le noir|devient blanc et vice-versa|" ' | | | Case "X" A$=A$+"Brush ('a‚rographe'..) |Pshiit pshiit!" Case 8 A$=A$+"InsŠre/d‚truit une ligne |horizontale" Case 22 A$=A$+"InsŠre/d‚truit une ligne |verticale" Case 114,147,"R" A$=A$+"Miroir (inversion horiz/vert)" Case "F" A$=A$+"Remplissage (… la couleur |inverse du point de d‚part)" Case 148,153 A$=A$+"Taille du texte … afficher |avec 'T'" Case 40,41 A$=A$+"Modifier le mode d'‚criture |(draw/brush/circle etc)|" A$=A$+"Crayon: normal/ Gomme: effacer|Inverseur: inverser (b"+Chr$(3)+"N/n"+Chr$(3)+"b)" Case 252 A$=A$+"D‚bugging..| |Aide dynamique |"+Name$+" | Cliquez sur Annuler" ' | | | Case 13,10 A$=A$+"Transf‚rer le graphique actuel|vers l'‚diteur en le codant|" A$=A$+"en instructions TXT "+Quote$+".."+Quote$ If N&=10 A$=A$+"|et en partant du bas vers le |haut (… l'envers)" Endif ' Case 0 Endselect ' Else if Index&=5 ' Select N& Case 148 ! t‚l‚chargement ' | | | A$=A$+"T‚l‚charger le jeu DRCS actuel|vers le minitel 2" Case 146 ! idem mais select A$=A$+"T‚l‚charger certains |caractŠres vers le minitel 2" Case 167 ! importer A$=A$+"Importer un fichier vid‚otex |contenant des d‚finitions de |" A$=A$+"caractŠres dans l'‚diteur DRCS" Case 174 ! capturer A$=A$+"Capturer les red‚finitions de |caractŠres re‡ues par |" A$=A$+"le minitel 2" Case 166 ! charger A$=A$+"Charger un jeu de caractŠres |DRCS" Case 177 ! idem mais en s‚lectionnant A$=A$+"Charger certains caractŠres |d'un jeu DRCS" Case 159 ! save \S A$=A$+"Sauver le jeu de caractŠres |DRCS de l'‚diteur" Case 172 ! \Write A$=A$+"Sauver certains caractŠres du |jeu DRCS de l'‚diteur" Case 175,173 ! save vdt ' | | | A$=A$+"Transcrire le jeu de |caractŠres de l'‚diteur en un|" A$=A$+"fichier vid‚otex utilisable |pour le t‚l‚chargement" Case 165 ! clr A$=A$+"Effacer le jeu de caractŠres |DRCS de l'‚diteur" Case 176 ! Digitaliser \B A$=A$+"Transcrire un bloc d'image en |bloc d'image DRCS" ' Case 150 ! selection G0/G0',G1/G1' A$=A$+"Passer en mode normal: TEXTE" Case 151 A$=A$+"Passer en mode drcs: TEXTE" Case 152 A$=A$+"Passer en mode normal:| GRAPHIQUE" Case 153 A$=A$+"Passer en mode drcs:| GRAPHIQUE" Endselect ' Else ' Select N& Case "O",16 A$=A$+"R‚gler les options de "+Name$ Case 187 A$=A$+"Compiler execute votre progra~|mme et le transcrit en codes|" A$=A$+"vid‚otex utilisables par le |minitel" Case 191 ' | | | A$=A$+"Capturer une page enregistre |les codes envoy‚s par le |" A$=A$+"minitel et les d‚pose dans |le buffer actuel.Option arrˆt|" A$=A$+"page: attendre un Cls … la fin" Case 192,193 A$=A$+"D‚sassembler transforme les |octets du buffer actuel en|" A$=A$+"instructions vid‚otex qui |seront visibles dans |" A$=A$+"l' ‚diteur vid‚otex" Case 188 A$=A$+"Optimiser sert … r‚duire la |place occupp‚e par une page|" A$=A$+"et ainsi la rendre plus rapide|… envoyer" Case 195 A$=A$+"D‚soptimiser ‚limine les |optimisations du buffer actuel|" A$=A$+"Cela a pour cons‚quence de |ralentir la page, mais aussi|" A$=A$+"de la rendre +simple ("+Chr$(3)+"d‚comp)" Case 196 A$=A$+"Compiler+optimiser: identique |… F1 + F2 + OPT ON ; ‚xecute|" A$=A$+"votre page et l'optimise" ' | | | Case 5 A$=A$+"Envoi votre page vers le |minitel … la vitesse actuelle|" A$=A$+"Pour voir le r‚sultat.." Case 212 A$=A$+"CHARGER votre programme sous |forme ASCII (provenant d'un|" A$=A$+"‚diteur de textes) |(*.LSW)" If Edited!(0) A$=A$+"|(Source non sauv‚)" Endif Case 177 A$=A$+"InsŠre un fichier ascii … la |position du curseur|" A$=A$+"(*.LSW)" Case 213 A$=A$+"SAUVER votre programme sous |forme ASCII|" A$=A$+"(*.LSW)" Case 500 A$=A$+"Informations sur un fichier |(*.*)" Case 501 A$=A$+"D‚truire un fichier quelconque|pour lib‚rer de la place sur|" A$=A$+"votre disque|(*.*)" Case 12 A$=A$+"CHARGER un fichier Sweetel2 |(… choisir dans la boite)|" A$=A$+"(*.*)" Case 912 A$=A$+"CHARGER un fichier SWEETEL |(‚diteur vid‚otex)|" A$=A$+"(*.SWT)" If Edited!(0) A$=A$+"|(Source non sauv‚)" Endif Case 19 A$=A$+"SAUVER un fichier Sweetel2 |(… choisir dans la boite)|" A$=A$+"(*.*)" Case 919 A$=A$+"SAUVER un source SWEETEL |(de l'‚diteur vid‚otex)|" A$=A$+"(*.SWT)" Case 189 A$=A$+"CHARGER un bloc vid‚otex |(une page vid‚otex)|" A$=A$+"(*.VDT)" Case 190 A$=A$+"SAUVER un bloc vid‚otex |(votre page compil‚e)|" A$=A$+"(*.VDT)" ' ' | | | Case "E" A$=A$+"Efface l' ‚cran de votre |minitel" Case 161 A$=A$+"SAUVER la configuration sur |disque|" A$=A$+"(options, positions fenˆtres |etc..)" Case 18 A$=A$+"Initialiser le minitel |(reset vid‚otex)" Case 147 A$=A$+"Initialiser le minitel |(synchro)" Case 146 A$=A$+"Envoi le buffer actuel sous |forme compatible avec les |" A$=A$+"serveurs, et lentement" Case "1" To "4" A$=A$+"Passer au buffer Nø"+Str$(N&-48) Case 200 A$=A$+"Passer au buffer Nø"+Str$(Min(Actb&+1,3)+1) Case 208 A$=A$+"Passer au buffer Nø"+Str$(Max(0,Actb&-1)+1) Case "V" A$=A$+"Changer la vitesse de trans~ |~fert Atari->Minitel" Case "M" A$=A$+"N'a pas grand interˆt.. |"+Chr$(3)+"Annuler" Case "*" A$="Option: |" If Acc! A$=A$+"Sauver les accents sous |forme ascii avec F4" Else A$=A$+"Sauver les accents sous |forme vid‚otex avec F4" Endif Case "F" A$="Option: |" If Expert! A$=A$+"Effacer buffer clavier par |moments" Else A$=A$+"Ne plus effacer le buffer |clavier" Endif Case "W" ' | | | A$=A$+"Option: |" A$=A$+"Ranger les fenˆtres ou |" If Effect! A$=A$+"enlever" Else A$=A$+"ajouter" Endif A$=A$+" les effets |graphiques (Graf_xxBox)" Case "A" If Ascii&=2 A$=A$+"Ne plus envoyer en ascii" Else A$=A$+"Envoyer en ascii "+Str$(Ascii&+1) Endif Case 174 A$=A$+"D‚finir les options de compi~ |lation g‚n‚rales:|" A$=A$+"-Envoi en mˆme temps ou non |-Garder le multitƒche pendant|" A$=A$+"(Actuel: " If Autosend! A$=A$+"Send-" Else A$=A$+"-" Endif If Set_multi! A$=A$+"Multi"+Str$(Set_mtime%) Else A$=A$+"-" Endif A$=A$+")" Case "T" ' | | | A$=A$+"D‚finir la taille du texte |(Attention, certaines tailles |" A$=A$+"sont incompatibles) ou les |couleurs de dessin/texte" Case 1 A$=A$+"Compiler en ascii |(‚liminer les chr<32)|" A$=A$+"("+Chr$(3)+"Fichier ascii *.TXT)" Case "L" A$="Option: |" If Slow! A$=A$+"Vitesse normale |(Vitesse actuelle)" Else A$=A$+"Vitesse r‚duite |(forcer 75 bps)" Endif Case 17,221 A$=A$+"Quitter "+Name$+" et retourner |au programme maŒtre" If Edited!(0) A$=A$+"|(Sauvegarder votre source|avant!)" Endif Case 225 A$=A$+"A ‚viter!" Case 3 A$=A$+"Effacer votre source actuel " If Edited!(0) A$=A$+"|(L'avez-vous sauv‚? Humm?)" Endif Case 11 A$=A$+"Fermer la fenˆtre" Case 23 A$=A$+"Voir tt les fenˆtres" X%=True Case "I",9 A$=A$+"Infos sur "+Name$+", version" X%=True Case 20 ! ^T ‚muler ' | | | A$=A$+"Emuler vous permet de rempla~ |cer le clavier minitel par|" A$=A$+"votre clavier Atari (plus |ergonomique). Des raccourcis|" A$=A$+"sont disponibles (Envoi etc..)" ' Case 0 ' ' Default ' A$=A$+"Op‚ration inconnue|Confirmez-vous cette op‚ration?..|Id="+Str$(N&) Endselect Endif ' | | | ' If Len(A$)>0 If X%=True X%=@Form_alert(1,"[3]["+A$+"][Confirmer ]") Else X%=@Form_alert(1,"[3]["+A$+"][Confirmer | Annuler ]") Endif Else X%=0 Endif If X%=2 Clr N& Endif Endif Return ' ' ' -------------------------------------------------- ' Fin du programme ' Wind tool: ' ' ' ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø. ' !!!WIND_TOOL 1.15!!!: ' ' Tool de gestion de fenˆtres multiples ' X.Roche Sept'92 ' Note: Coordonn‚es compatibles PAO (32 bits) ' ' ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø. ' ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø.ø. ' ' ' '`'`'`'`'`'`'`'`'`'` ' ..Appl_init() & reserves. Procedure Init Local A% ' If Work_out(0)*Work_out(1)=0 ! ecran non pr‚sent ' @Printl(Chr$(27)+"EApplication n‚cessitant l'environnement GEM..") ~Gemdos(1) @Printl("Leaving..") On error gosub Eop Edit ' ' Else ' Ap&=Appl_init() A%=Lpeek(Gb+4) ! global() A%=Dpeek(A%+2) ! global(1) (multi-) Multi!=(A%<>1) ! multitache? ' A%=Lpeek(Basepage+36) ! parent? If A%=0 ! non -> acc ' accessoire!=True ' pas +4 octets nuls piti‚! Me_id&=Menu_register(Ap&,Atitle$) ~@Form_alert(1,"[3][|Ne fonctionne plus comme |accessoire!!|D‚sactivez SWEETEL2.ACC!!!!!][Hell!]") Endif ' ' Chaine d'env? ~Shel_read(Nom_prg$,Param_prg$) ! ligne environnement Nom_prg$=@Trimasc$(Nom_prg$) Param_prg$=@Trimasc$(Param_prg$) Aesv%=Dpeek(Lpeek(Gb+4)) ' Gosub Deftext(Col1&,&X0) Gosub Deffillcol(Colg&) Gosub Color(Colg&) ' ' ..Coord du bureau GEM? ~Wind_get(0,4,X_desk&,Y_desk&,W_desk&,H_desk&) ' Dim Wmenu&(7) ! Tampon message ' ..Messages pr‚d‚finis: Mn_selected&=10 Wm_redraw&=20 Wm_topped&=21 Wm_closed&=22 Wm_fulled&=23 Wm_arrowed&=24 Wm_hslid&=25 Wm_vslid&=26 Wm_sized&=27 Wm_moved&=28 Wm_newtop&=29 Wm_bottomed&=33 Wm_smaller&=34 Wm_unsmaller&=35 Wm_allsmaller&=36 Ac_open&=40 Ac_close&=41 ' A_uppage&=0 Wa_dnpage&=1 Wa_upline&=2 Wa_dnline&=3 Wa_lfpage&=4 Wa_rtpage&=5 Wa_lfline&=6 Wa_rtline&=7 ' Get_csize Gosub M_init ' Endif ' Return Function Trimasc$(A$) Local A& Local B$ ' Clr B$ For A&=1 To Len(A$) If Asc(Mid$(A$,A&,1))=>32 B$=B$+Mid$(A$,A&,1) Endif Next A& A$=Trim$(Upper$(B$)) Clr B$ Return A$ Endfunc ' ..On finit: Appl_exit(). Procedure Uninit Erase Wmenu&() Erase G_s%(),G_screen%(),R_d%(),G_s2%() Gosub M_uninit ' ~Appl_exit() ' Return ' ..Attendre d'etre appell‚ Procedure Start ' ..Application? => Sauter directement! Apgem%=Lpeek(Lpeek(Lpeek(&H4F2)+40)) ! IDGem ' Gosub Gdos Gosub Init ! Init ' If Accessoire!=False ! pas en *.ACC ' Reserve Mem% ! d‚j… fait en $mXXXX ' ..Ouvrir champs ~@Winds_init(Nombre_w&-1) ' Do ! on peut faire une boucle! (test) @Menu_open ! menu on Gosub Princ @Menu_close ! menu off ' Loop until Mousek=2 ' ..Non, accessoire => Attendre son tour! ' Else ' ' 'Me_id&=Menu_register(Ap&,Atitle$+Mkl$(0)) ' ..Ouvrir champs ' ~@Winds_init(Nombre_w&-1) ' Do ' ~Evnt_mesag(Varptr(Wmenu&(0))) ' If Wmenu&(0)=40 ' If Wmenu&(4)=Me_id& ! a nous? ' Gosub Princ ' Endif ' Endif ' Loop ' ' Endif Gosub Winds_uninit Gosub Ungdos Gosub Uninit ' If Len(Malloc$)>0 Gosub Mxfree ~@Form_alert(1,"[3][Contr“le m‚moire Sweetel|Bloc(s) orphelins|Il se peut qu'une erreur |se soit produite][Not‚]") Endif ' ' Reserve ! .. On error gosub Eop Edit End Return ' ' '`'`'`'`'`'`'`'`'`'` ' ..Traiter un ‚ventuel message dans WMenu&() ' Retour: -1=fermeture forc‚e, wclose()/wdelete() effectu‚s ' 0=message trait‚ ' >0=ce message est inconnu ou non trait‚ ' ParamŠtre: -1 = Tout traiter ' X: bit 1 = traiter les close bit 2 = traiter les full ' bit 3 = traiter les move bit 5 = traiter les size ' bit 6 = arrows/sliders bit 8 = vslide ' bit 11 = hslide ' bit 16 = redraw bit 17 = topped Function Wmanage(X%) $F% Local Ha&,Pts%,Index&,X2& Local Formx&,Formy&,Formw&,Formh& ' Clr Formx&,Formy&,Formw&,Formh& ! Forms Dials (interdits sous wind_update 1!!) ' ' ' ..Cela nous concerne -t- il? If (@Windex(Wmenu&(3))<>-1) Or (Wmenu&(0)=Ac_open& Or Wmenu&(0)=Ac_close&) Or (Wmenu&(0)=10) ' Clr X2& ! Message pr‚d‚fini Ha&=@Windex(Wmenu&(3)) ! Index de fenˆtre? Select Wmenu&(0) ' Case Wm_redraw& ! ..Redessiner If Btst(X%,16) Gosub Rd_all(Ha&,Wmenu&(4),Wmenu&(5),Wmenu&(6),Wmenu&(7)) Endif ' Case Wm_topped& ! ..Demande d'activation If Btst(X%,17) Select And(@Bios11,&X1111) Case 0 Wtop_move(Ha&) Case &X100 Index&=@Xfirstw If Index&=>0 If Ha&<>Nombre_w&-1 ! perso Swapw(Index&,Ha&) Endif Endif Default @Xtop(Ha&) Endselect Endif ' Case Wm_bottomed& ! ..Demande de changement de fenˆtre If Btst(X%,17) Gosub Xtop(@Nextw(Ha&)) Endif ' Case Wm_closed& ! ..Champ closed If Btst(X%,1) If Not (And(@Bios11,&X1111)=&X1000) ! alt ~@Wind_close(Ha&) Else ' @Wind_closeall(0,Nbr_idxw&) @Wind_closeall(0,Nbr_idxw&-1) ! perso PERSO Endif Endif ' Case Wm_fulled& ! ..Champ fulled If Btst(Wxflag%(Ha&),1) Gosub Smaller(Ha&,True) Else If Btst(X%,2) Gosub Setfulled(Ha&) Endif Endif ' Case Wm_arrowed& ! ..Fleche ' If (One_sl!=False Or @Xmousek<>0) If @Xmousek=0 ! un seul slide One_sl!=True ! le d‚clarer Endif If Btst(X%,6) Select Wmenu&(4) ! Quel fleche a ‚t‚ cliqu‚e? ' Case A_uppage& To Wa_dnline& ! Fleches Verticales: Pts%=Start_y%(Ha&) ! Ajout en Y Select Wmenu&(4) ' Case A_uppage& ! Page Up Sub Pts%,W_ih&(Ha&)-Ccsizey& Case Wa_dnpage& ! Page Down Add Pts%,W_ih&(Ha&)-Ccsizey& Case Wa_upline& ! Line Up Sub Pts%,Ccsizey& ' Case Wa_dnline& ! Line Down Add Pts%,Ccsizey& ' If Ha&=0 ! perso ' Pts%=True ! ' X2&=Wmenu&(0) ' Endif ! perso ' Endselect ' V_dec(Ha&,Pts%) ! d‚calage vertical ' Case Wa_lfpage& To Wa_rtline& ! Fleches horizontales: ' Pts%=Start_x%(Ha&) ! Ajout en X Select Wmenu&(4) ' Case Wa_lfpage& ! Page vers la gauche Sub Pts%,W_iw&(Ha&)-Ccsizex& Case Wa_rtpage& ! Page vers la droite Add Pts%,W_iw&(Ha&)-Ccsizex& Case Wa_lfline& ! Colonne vers la gauche Sub Pts%,Ccsizex& Case Wa_rtline& ! Colonne vers la droite Add Pts%,Ccsizex& Endselect ' H_dec(Ha&,Pts%) ! d‚calage horizontal ' Endselect Endif ! test one slide Else One_sl!=False Endif ' ' ' ' Case Wm_hslid& If Btst(X%,11) ' ..HorSlide Pts%=((Max_w%(Ha&)-W_iw&(Ha&))*Wmenu&(4))\1000 H_dec(Ha&,Pts%) ' Pts%=@W_hslnorm(Ha&,Pts%) ' If Start_X%(Ha&)<>Pts% ' Start_X%(Ha&)=Pts% ' Wsetsl(Ha&) ' Gosub Drawx(Ha&) ' Gosub Fdnotice(Ha&,W_ix&(Ha&),W_iy&(Ha&),W_iw&(Ha&),W_ih&(Ha&)) ' Endif Endif Case Wm_vslid& If Btst(X%,8) ' ..VertSlide Pts%=((Max_h%(Ha&)-W_ih&(Ha&))*Wmenu&(4))\1000 V_dec(Ha&,Pts%) ' Pts%=@W_vslnorm(Ha&,Pts%) ' If Start_y%(Ha&)<>Pts% ' Start_y%(Ha&)=Pts% ' Wsetsl(Ha&) ' Gosub Drawx(Ha&) ' Gosub Fdnotice(Ha&,W_ix&(Ha&),W_iy&(Ha&),W_iw&(Ha&),W_ih&(Ha&)) ' Endif Endif Case Wm_sized& If Btst(X%,5) ' ..Taille Gosub Setxywh(Ha&,Wmenu&(4),Wmenu&(5),Wmenu&(6),Wmenu&(7)) Endif Case Wm_moved& If Btst(X%,3) ' ..Position Gosub Setxywh(Ha&,Wmenu&(4),Wmenu&(5),Wmenu&(6),Wmenu&(7)) Endif Case Wm_newtop& ' ..Fenˆtre active par suite de la fermeture d'une autre Gosub Xtop(Ha&) ' Case Wm_smaller& ' ..Smaller pour la fenˆtre If Not Btst(Wxflag%(Ha&),1) Gosub Smaller(Ha&,True) Endif ' Case Wm_unsmaller& ' ..UnSmaller pour la fenˆtre If Btst(Wxflag%(Ha&),1) Gosub Smaller(Ha&,True) Endif ' Case Wm_allsmaller& ' ..Smaller pour toutes les fenˆtres Clr Index& For Pts%=0 To Nbr_idxw& If Btst(Wflag%(Pts%),14) ! Smaller? If Wopen!(Pts%) If Not Btst(Wxflag%(Pts%),1) Smaller(Pts%,True) Endif Setxywh(Pts%,X_desk&+2,Y_desk&+Index&*(W_attrh&(Pts%)+2),W_ew&(Pts%),W_eh&(Pts%)) @Xtop(Pts%) Inc Index& Endif Else If Btst(Wxflag%(Pts%),1) Setxywh(Pts%,X_desk&+2,Y_desk&+Index&*(W_attrh&(Pts%)+2),W_ew&(Pts%),W_eh&(Pts%)) @Xtop(Pts%) Inc Index& Endif Endif Next Pts% ' Case Ac_open& ' ..Ac_open, dans menu (accessoire) Gosub Xtop(@Nextw(0)) Case Ac_close& ' ..Fenˆtres deja ferm‚es.. X2&=-1 ! Retour=-1 Arrayfill Wopen!(),False Arrayfill Whandle&(),True ' Clr Formx&,Formy&,Formw&,Formh&,Formi& Default X2&=Wmenu&(0) Endselect ' Endif ' ' ~ @Wind_update01(0) ! D‚v‚rouillage Gosub Fdtest ' ' ' retour ' -1 = acclose, toute les fenˆtres ont ‚t‚s ferm‚es et d‚truites ' 0 = message trait‚ ' >0 = message non trait‚ ou inconnu (retour: message non trait‚) ' Return X2& Endfunc ' ' '`'`'`'`'`'`'`'`'`'` ' ..Noter form_dial Procedure Fdnotice(Index&,X&,Y&,W&,H&) Formi&=Index& Formx&=X& Formy&=Y& Formw&=W& Formh&=H& Return ' ' D‚caler wind Ha& vers Pts en Start_y() Procedure V_dec(Ha&,Pts%) ! d‚caler vers Pts% Local Y2%,W&,H& ' Clip_off ' W&=Min(W_iw&(Ha&)+W_ix&(Ha&),Work_out(0)) H&=Min(W_ih&(Ha&)+W_iy&(Ha&),Work_out(1)) W&=W&-W_ix&(Ha&) ! pas de +1= W+X puis -X -> =W ! H&=H&-W_iy&(Ha&) ! idem pour h ' Pts%=@W_vslnorm(Ha&,Pts%) ! V‚rifier l'intervalle Verticale If Start_y%(Ha&)<>Pts% ! Modifi‚e? Y2%=Pts%-Start_y%(Ha&) ! Noter inc Start_y%(Ha&)=Pts% ! Alors ‚crire nouveau W_Ay Wsetsl(Ha&) ! Modifier sliders Gosub Drawx(Ha&) Endif ' On top/d‚calage petit/starting >0? If @Wtestop(Ha&) And Abs(Y2%)0 And W_iy&(Ha&)>0 If Y2%>0 ! Down ' Scr_copy(W_ix&(Ha&),W_iy&(Ha&)+Y2%,W&,H&-Y2%-1,W_ix&(Ha&),W_iy&(Ha&)) Scr_copy(W_ix&(Ha&),W_iy&(Ha&)+Y2%,W&,H&-Y2%-1,W_ix&(Ha&),W_iy&(Ha&)) Gosub Fdnotice(Ha&,W_ix&(Ha&),W_iy&(Ha&)+H&-Y2%-1,W&,Y2%+1) Else if Y2%<0 ! Up ' Scr_copy(W_ix&(Ha&),W_iy&(Ha&),W&,H&+Y2%-1,W_ix&(Ha&),W_iy&(Ha&)-Y2%) Scr_copy(W_ix&(Ha&),W_iy&(Ha&),W&,H&+Y2%,W_ix&(Ha&),W_iy&(Ha&)-Y2%) Gosub Fdnotice(Ha&,W_ix&(Ha&),W_iy&(Ha&),W&,-Y2%) Endif Else Gosub Fdnotice(Ha&,W_ix&(Ha&),W_iy&(Ha&),W&,H&) Endif Return ' ' D‚caler wind Ha& vers Pts en Start_x() Procedure H_dec(Ha&,Pts%) ! d‚caler vers Pts% Local X2%,W&,H& ' Clip_off ' W&=Min(W_iw&(Ha&)+W_ix&(Ha&),Work_out(0)) H&=Min(W_ih&(Ha&)+W_iy&(Ha&),Work_out(1)) W&=W&-W_ix&(Ha&)+1 H&=H&-W_iy&(Ha&)+1 ' Pts%=@W_hslnorm(Ha&,Pts%) ! V‚rifier l'intervalle Verticale If Start_x%(Ha&)<>Pts% ! Modifi‚e? X2%=Pts%-Start_x%(Ha&) ! Noter inc Start_x%(Ha&)=Pts% ! Alors ‚crire nouveau W_Ay Wsetsl(Ha&) ! Modifier sliders Gosub Drawx(Ha&) Endif Clip Off ' On top/d‚calage petit/starting? If @Wtestop(Ha&) And Abs(X2%)0 And W_iy&(Ha&)>0 If X2%>0 ! Down Scr_copy(W_ix&(Ha&)+X2%,W_iy&(Ha&),W&-X2%-1,H&,W_ix&(Ha&),W_iy&(Ha&)) Gosub Fdnotice(Ha&,W_ix&(Ha&)+W_iw&(Ha&)-X2%,W_iy&(Ha&),X2%,H&) Else if X2%<0 ! Up Scr_copy(W_ix&(Ha&),W_iy&(Ha&),W&+X2%-1,H&,W_ix&(Ha&)-X2%,W_iy&(Ha&)) Gosub Fdnotice(Ha&,W_ix&(Ha&),W_iy&(Ha&),-X2%,H&) Endif Else Gosub Fdnotice(Ha&,W_ix&(Ha&),W_iy&(Ha&),W&,H&) Endif Return ' ' ..Executer ‚ventuellement form_dial Procedure Fdtest Local X& If Formx&<>0 Gosub Rd_all(Formi&,Formx&,Formy&,Formw&,Formh&) Clr Formx&,Formy&,Formw&,Formh&,Formi& Endif Return ' Procedure Wtop_move(Ha&) Local X&,Y&,Mk&,B& Local X2&,Y2& Local W&,H& ' ~Graf_mkstate(X&,Y&,Mk&,B&) ' ___________________ ' |_|_____________|_| } %100 (4) ' | | | | ' | | 0 | | ' | | | | ' |_|_____________|_| ' | | | | } %1000 (8) ' ------------------- ' ^%10 (2) ' ' Clr B& If Y&W_iy&(Ha&)+W_ih&(Ha&) Add B&,&X1000 Endif ' If X&W_ix&(Ha&)+W_iw&(Ha&) Add B&,&X10 Endif ' If B&=0 @Xtop(Ha&) Else ' ~@Wind_update01(1) AGHHHHHHHH attend le bouton souris!! Defline 7,1,0,0 Contrl(0)=113 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h A%=&X10101010101010101010101010101010 Intin(0)=Shr(A%,Pic_t&) Vdisys Select B& Case 2 Defmouse 4 Graphmode 3 X2&=-1 Clip X_desk&,Y_desk&,W_desk&,H_desk& ' Clip Off ! CA PLANTE EN CAS DE DEPASSEMENT!!!! Do ~Graf_mkstate(X&,Y&,Mk&,B&) ' Mouse X&,Y&,Mk& X&=Max(W_ex&(Ha&)+W_attrw&(Ha&)+60,X&) If X2&<>X& @Lhidem If X2&<>-1 Box W_ex&(Ha&),W_ey&(Ha&),X2&,W_ey&(Ha&)+W_eh&(Ha&) Endif Box W_ex&(Ha&),W_ey&(Ha&),X&,W_ey&(Ha&)+W_eh&(Ha&) @Lshowm Endif X2&=X& Y2&=Y& Loop until Mk&<>1 @Lhidem Box W_ex&(Ha&),W_ey&(Ha&),X&,W_ey&(Ha&)+W_eh&(Ha&) @Lshowm Graphmode 1 Defmouse 0 ' ' ~@Wind_update01(0) Setxywh(Ha&,W_ex&(Ha&),W_ey&(Ha&),X&-W_ex&(Ha&)+1,W_eh&(Ha&)) ' Case 4 Defmouse 4 Graphmode 3 W&=W_ex&(Ha&)-X& H&=W_ey&(Ha&)-Y& X2&=-1 ' Clip Off Clip X_desk&,Y_desk&,W_desk&,H_desk& Do ~Graf_mkstate(X&,Y&,Mk&,B&) ' Mouse X&,Y&,Mk& X&=Max(X_desk&,X&+W&) Y&=Max(Y_desk&,Y&+H&) If X2&<>X& Or Y2&<>Y& @Lhidem If X2&<>-1 Box X2&,Y2&,X2&+W_ew&(Ha&),Y2&+W_eh&(Ha&) Endif Box X&,Y&,X&+W_ew&(Ha&),Y&+W_eh&(Ha&) @Lshowm Endif X2&=X& Y2&=Y& Loop until Mk&<>1 @Lhidem Box X&,Y&,X&+W_ew&(Ha&),Y&+W_eh&(Ha&) @Lshowm Graphmode 1 Defmouse 0 ' ' ~@Wind_update01(0) If X&=W_ex&(Ha&) And Y&=W_ey&(Ha&) @Xtop(Ha&) Else Setxywh(Ha&,X&,Y&,W_ew&(Ha&),W_eh&(Ha&)) Endif ' Case 6 Defmouse 5 @Setfulled(Ha&) Defmouse 0 Case 8 Defmouse 4 Graphmode 3 X2&=-1 ' Clip Off Clip X_desk&,Y_desk&,W_desk&,H_desk& Do ~Graf_mkstate(X&,Y&,Mk&,B&) ' Mouse X&,Y&,Mk& Y&=Max(W_ey&(Ha&)+W_attrh&(Ha&)+40,Y&) If Y2&<>Y& @Lhidem If X2&<>-1 Box W_ex&(Ha&),W_ey&(Ha&),W_ex&(Ha&)+W_ew&(Ha&),Y2& Endif Box W_ex&(Ha&),W_ey&(Ha&),W_ex&(Ha&)+W_ew&(Ha&),Y& @Lshowm Endif X2&=X& Y2&=Y& Loop until Mk&<>1 @Lhidem Box W_ex&(Ha&),W_ey&(Ha&),W_ex&(Ha&)+W_ew&(Ha&),Y& @Lshowm Graphmode 1 Defmouse 0 ' ' ~@Wind_update01(0) Setxywh(Ha&,W_ex&(Ha&),W_ey&(Ha&),W_ew&(Ha&),Y&-W_ey&(Ha&)+1) ' Case 10 Defmouse 3 Graphmode 3 X2&=-1 ' Clip Off Clip X_desk&,Y_desk&,W_desk&,H_desk& Do ~Graf_mkstate(X&,Y&,Mk&,B&) ' Mouse X&,Y&,Mk& X&=Max(W_ex&(Ha&)+W_attrw&(Ha&)+60,X&) Y&=Max(W_ey&(Ha&)+W_attrh&(Ha&)+40,Y&) If X2&<>X& Or Y2&<>Y& @Lhidem If X2&<>-1 Box W_ex&(Ha&),W_ey&(Ha&),X2&,Y2& Endif Box W_ex&(Ha&),W_ey&(Ha&),X&,Y& @Lshowm Endif X2&=X& Y2&=Y& Loop until Mk&<>1 @Lhidem Box W_ex&(Ha&),W_ey&(Ha&),X&,Y& @Lshowm Graphmode 1 Defmouse 0 Setxywh(Ha&,W_ex&(Ha&),W_ey&(Ha&),X&-W_ex&(Ha&)+1,Y&-W_ey&(Ha&)+1) ' Endselect Defline 1,1,0,0 Endif ' ' ~Graf_dragbox(W_ew&(Ha&),W_eh&(Ha&),W_ex&(Ha&),W_ey&(Ha&),X_desk&,Y_desk&,W_desk&,H_desk&,X&,Y&) Return ' ' '`'`'`'`'`'`'`'`'`'` ' ..Fonctions de base: Nbr_idxw=nombre d'index d‚clar‚s. ' ..Dimensionner tous les champs max. Function Winds_init(Decl_idw&) ! *** $F% Local Loop_&,C& ' Nbr_idxw&=Decl_idw& ! TrŠs important! ' ..Handles,Flags,Tampons titres & infos. Dim Whandle&(Nbr_idxw&),Wflag%(Nbr_idxw&),Wxflag%(Nbr_idxw&),Wopen!(Nbr_idxw&),Winfo%(Nbr_idxw&),Wtitle%(Nbr_idxw&) Arrayfill Wopen!(),False Arrayfill Whandle&(),-1 ! Vides Arrayfill Winfo%(),-1 ! Vides Arrayfill Wtitle%(),-1 ! Vides Arrayfill W_fx&(),X_desk& ! Prochain fuller: Arrayfill W_fx&(),Y_desk& ! dimensions maximales Arrayfill W_fx&(),W_desk& ! du bureau Arrayfill W_fx&(),H_desk& ! ' ..Coord externes des fenˆtres Dim W_ex&(Nbr_idxw&),W_ey&(Nbr_idxw&),W_ew&(Nbr_idxw&),W_eh&(Nbr_idxw&) ' ..Coord internes des fenˆtres Dim W_ix&(Nbr_idxw&),W_iy&(Nbr_idxw&),W_iw&(Nbr_idxw&),W_ih&(Nbr_idxw&) ' ..Incr‚mentation de la fenˆtre. Dim Start_x%(Nbr_idxw&),Start_y%(Nbr_idxw&) ' ..Dimensions maximales et minimales des fenˆtres Dim Max_w%(Nbr_idxw&),Max_h%(Nbr_idxw&) ' ..Anciennes coord (pour fulled) Dim W_fx&(Nbr_idxw&),W_fy&(Nbr_idxw&),W_fw&(Nbr_idxw&),W_fh&(Nbr_idxw&) ' ..Taille des attributs par rapport … la fenˆtre Dim W_attrw&(Nbr_idxw&),W_attrh&(Nbr_idxw&) ' ..Pour l'entr‚e Do_Winput Dim Dwx_&(Nbr_idxw&),Dw_x%(Nbr_idxw&),Dw_y%(Nbr_idxw&),Dw_$(Nbr_idxw&),Dwf_&(Nbr_idxw&) ' ~Fre(0) ' ..R‚servation m‚moire pour les titres et infos. If Wtitle%(0)<0 Wtitle%(0)=@Malloc(256*$ And And And And Eqv And *(Nbr_idxw&+1)+256) If Wtitle%(0)<0 Return Wtitle%(0) Endif ' ..Calcul des adresses infow/titlew For Loop_&=0 To Nbr_idxw& Winfo%(Loop_&)=Wtitle%(0)+256+Loop_&*512 Wtitle%(Loop_&)=Wtitle%(0)+Loop_&*512 Next Loop_& Else Return True Endif Gosub Iniscr ! init screen Get_csize ' Ccsizex&=Largeur caractŠre ' Ccsizey&=Hauteur caractŠre ' Return @Winds_fields ' Endfunc ' ' ..Initialiser paramŠtres (XYWH etc..) d'une fenˆtre Index ' Si flag=-1 alors valable pour TOUTES les fenˆtres ' ..Pour les coord XYWH de la fenˆtre Procedure Wset_x(Index&,X&) If Index&=-1 Arrayfill W_ex&(),X& Else W_ex&(Index&)=X& Endif Return Procedure Wset_y(Index&,Y&) If Index&=-1 Arrayfill W_ey&(),Max(Y_desk&,Y&) Else W_ey&(Index&)=Max(Y_desk&,Y&) Endif Return Procedure Wset_w(Index&,W&) If Index&=-1 Arrayfill W_ew&(),W& Else W_ew&(Index&)=W& Endif Return Procedure Wset_h(Index&,H&) If Index&=-1 Arrayfill W_eh&(),H& Else W_eh&(Index&)=H& Endif Return ' ..Pour les offsets XY (normalement 0) Procedure Wset_start_x(Index&,X%) If Index&=-1 Arrayfill Start_x%(),X% Else Start_x%(Index&)=X% Endif Return Procedure Wset_start_y(Index&,Y%) If Index&=-1 Arrayfill Start_y%(),Y% Else Start_y%(Index&)=Y% Endif Return ' ..Pour la les largeurs et hauteurs maximales Procedure Wset_max_w(Index&,W%) If Index&=-1 Arrayfill Max_w%(),W% Else Max_w%(Index&)=W% Endif Return Procedure Wset_max_h(Index&,H%) If Index&=-1 Arrayfill Max_h%(),H% Else Max_h%(Index&)=H% Endif Return ' ..Pour les flags de la fenˆtre (masque de bits) Procedure Wset_flags(Index&,X&) If Index&=-1 Arrayfill Wflag%(),X& Else Wflag%(Index&)=X& Endif Return ' ' R‚gler attributs sur la fenˆtre Index Procedure Wsetat(Index&,X&) Wflag%(Index&)=X& ~Wind_set(Whandle&(Index&),1,X&,0,0,0) Return ' ..Indique si les coordonn‚es maximales doivent etre ' imp‚rativement respect‚es (on) ou non (off) Procedure Wmax_on(Index&) Local A& If Index&=-1 For A&=1 To Nbr_idxw& Wxflag%(A&)=Bset(Wxflag%(A&),0) Next A& Else Wxflag%(Index&)=Bset(Wxflag%(Index&),0) Endif Return Procedure Wmax_off(Index&) Local A& If Index&=-1 For A&=1 To Nbr_idxw& Wxflag%(A&)=Bclr(Wxflag%(A&),0) Next A& Else Wxflag%(Index&)=Bclr(Wxflag%(Index&),0) Endif Return ' ' ..D‚dimensionner tous les champs. Procedure Winds_uninit Local Reponse% ' ..D‚sallouer m‚moire Malloc If Wtitle%(0)>0 Reponse%=Wtitle%(0) Reponse%=@Mfree(Reponse%) ' Wtitle%(0)=Reponse% Wtitle%(0)=-1 Endif ' ..Handles,Flags,Tampons. Erase Whandle&(),Wflag%(),Wxflag%(),Wopen!(),Winfo%(),Wtitle%() ' ..Coord externes des fenˆtres Erase W_ex&(),W_ey&(),W_ew&(),W_eh&() ' ..Coord internes des fenˆtres Erase W_ix&(),W_iy&(),W_iw&(),W_ih&() ' ..Incr‚mentation de la fenˆtre. Erase Start_x%(),Start_y%() ' ..Dimensions maximales et minimales des fenˆtres Erase Max_w%(),Max_h%() ' ..Anciennes coord (pour fulled) Erase W_fx&(),W_fy&(),W_fw&(),W_fh&() ' ..Taille des attributs par rapport … la fenˆtre Erase W_attrw&(),W_attrh&() ' ..Pour l'entr‚e Do_Winput Erase Dwx_&(),Dw_x%(),Dw_y%(),Dw_$(),Dwf_&() ' ~Fre(0) Return ' ' '`'`'`'`'`'`'`'`'`'` ' ..Cr‚er la fenˆtre #X (index X) Function Wind_create(Index&) $F% Local Reponse% ' ..Champ vide? If Whandle&(Index&)<0 Reponse%=Wind_create(Wflag%(Index&),X_desk&,Y_desk&,W_desk&,H_desk&) Whandle&(Index&)=Reponse% If Reponse%=>0 Gosub Desmall(Index&) If Btst(Wflag%(Index&),0) ~Wind_set(Whandle&(Index&),2,Card(Swap(Wtitle%(Index&))),Card(Wtitle%(Index&)),0,0) Endif If Btst(Wflag%(Index&),4) ~Wind_set(Whandle&(Index&),3,Card(Swap(Winfo%(Index&))),Card(Winfo%(Index&)),0,0) Endif Endif Else Reponse%=-1 Endif ' Return Reponse% Endfunc ' ' ..D‚truire la fenˆtre #X (champ X) Function Wind_delete(Index&) $F% Local Reponse% ' ..Fenˆtre encore la? If Whandle&(Index&)=>0 Gosub Desmall(Index&) If Wopen!(Index&) ! encore ouverte?? ~@Wind_close(Index&) Endif Reponse%=Wind_delete(Whandle&(Index&)) ' ..Annuler handle Whandle&(Index&)=-1 Else Reponse%=-1 Endif ' Return Reponse% Endfunc ' ' ..Ouvrir la fenˆtre #X (champ X) Function Wind_open(Index&) $F% Local Reponse% ' If Whandle&(Index&)<0 ! not created? ~@Wind_create(Index&) Endif If Whandle&(Index&)=>0 If Wopen!(Index&)=False Wmove(0,0,1,1,W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&)) Wsetsl(Index&) Reponse%=Wind_open(Whandle&(Index&),W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&)) ~Wind_get(Whandle&(Index&),5,W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&)) ~Wind_get(Whandle&(Index&),4,W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) Gosub Desmall(Index&) ~Wind_calc(1,Wflag%(Index&),W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&),W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) W_attrw&(Index&)=W_ew&(Index&)-W_iw&(Index&) W_attrh&(Index&)=W_eh&(Index&)-W_ih&(Index&) Wopen!(Index&)=True Wsetsl(Index&) Get_csize Gosub Drawx(Index&) Endif Else Reponse%=True Endif ' Return Reponse% Endfunc ' ' ..Fermer la fenˆtre #X (champ X) Function Wind_close(Index&) $F% Local Reponse% ' If Whandle&(Index&)=>0 Gosub Desmall(Index&) If Wopen!(Index&) Reponse%=Wind_close(Whandle&(Index&)) Wmove(W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&),0,0,1,1) Wopen!(Index&)=False If Dim?(Dw_$()) Do_wclr(Index&) Endif Else Reponse%=True Endif ~@Wind_delete(Index&) Else Reponse%=True Endif ' Return Reponse% Endfunc ' ' ..Fermer la fenˆtre #X et la r‚ouvrir aussit“t (champ X) Function Wind_reopen(Index&) $F% Local Reponse% ' If Whandle&(Index&)=>0 If Wopen!(Index&) Reponse%=Wind_close(Whandle&(Index&)) Wopen!(Index&)=False Else Reponse%=True Endif Reponse%=Wind_delete(Whandle&(Index&)) Whandle&(Index&)=-1 ' If Whandle&(Index&)<0 ! not created? Reponse%=Wind_create(Wflag%(Index&),X_desk&,Y_desk&,W_desk&,H_desk&) Whandle&(Index&)=Reponse% If Reponse%=>0 If Btst(Wflag%(Index&),0) ~Wind_set(Whandle&(Index&),2,Card(Swap(Wtitle%(Index&))),Card(Wtitle%(Index&)),0,0) Endif If Btst(Wflag%(Index&),4) ~Wind_set(Whandle&(Index&),3,Card(Swap(Winfo%(Index&))),Card(Winfo%(Index&)),0,0) Endif Endif Else Reponse%=True Endif If Whandle&(Index&)=>0 If Wopen!(Index&)=False Wsetsl(Index&) Reponse%=Wind_open(Whandle&(Index&),W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&)) ~Wind_get(Whandle&(Index&),5,W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&)) ~Wind_get(Whandle&(Index&),4,W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) ~Wind_calc(1,Wflag%(Index&),W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&),W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) W_attrw&(Index&)=W_ew&(Index&)-W_iw&(Index&) W_attrh&(Index&)=W_eh&(Index&)-W_ih&(Index&) Wopen!(Index&)=True Wsetsl(Index&) Endif Else Reponse%=True Endif Else Reponse%=True Endif ' Return Reponse% Endfunc ' ' '`'`'`'`'`'`'`'`'`'` ' Open all Procedure Wind_openall(X&,Y&) Local A& ' For A&=X& To Y& ' Exit if @Wind_open(A&)=True ! Error Repeat Evnmnt&=Evnt_multi(&X110000,0,0,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),50) If Btst(Evnmnt&,4) Reponse%=@Wmanage(True) If Reponse%=-1 End!=True Endif Endif ! fin de if evnt-mesag Exit if Ha&=True Until Btst(Evnmnt&,5) Exit if Ha&=True Next A& Return ' ' Close all Procedure Wind_closeall(X&,Y&) Local A& ' For A&=X& To Y& ' ~@Wind_close(A&) Repeat Evnmnt&=Evnt_multi(&X110000,0,0,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),50) If Btst(Evnmnt&,4) Reponse%=@Wmanage(True) If Reponse%=-1 End!=True Endif Endif ! fin de if evnt-mesag Exit if Ha&=True Until Btst(Evnmnt&,5) Exit if Ha&=True Next A& Return ' ' ..Message redraw: #Index,XYWH, Wind_Update pas encore activ‚. Procedure Rd_all(Index&,X&,Y&,W&,H&) Local A&,Rx&,Ry&,Rw&,Rh&,T$,X2& ' ' Fenˆtre ouverte? If Wopen!(Index&) @Lhidem A&=@Wind_update01(-1) If A&=0 ' ..Verouillage du GEM ~@Wind_update01(1) Endif Clr T$ Clr X2& ~Wind_get(Whandle&(Index&),11,Rx&,Ry&,Rw&,Rh&) While Rw&>0 ' If Rc_intersect(X&,Y&,W&,H&,Rx&,Ry&,Rw&,Rh&) Gosub Redraw(Index&,Rx&,Ry&,Rw&,Rh&) Endif ~Wind_get(Whandle&(Index&),12,Rx&,Ry&,Rw&,Rh&) ' Wend If A&=0 ! Restaurer situation ' ..D‚v‚rouillage du GEM ~@Wind_update01(0) Endif @Lshowm Endif ' Return ' ' ..Tester si on voit l'int‚gralit‚ de la fenˆtre Index Function W_tstview(Index&) Local A&,Rx&,Ry&,Rw&,Rh&,T$,X2& ' If Wopen!(Index&) A&=@Wind_update01(-1) If A&=0 A&=@Wind_update01(1) Endif Clr T$ Clr X2& ~Wind_get(Whandle&(Index&),11,Rx&,Ry&,Rw&,Rh&) If A&=0 ! Restaurer situation ~@Wind_update01(0) Endif If Rx&=W_ix&(Index&) If Ry&=W_iy&(Index&) If Rw&=W_iw&(Index&) If Rh&=W_ih&(Index&) Return True ! on voit tout! Endif Endif Endif Endif Endif Return False Endfunc ' ' ' ' ..Execute tous les RedrawS en attente! Procedure W_rdexe Local Evnmnt&,Reponse% ' ' ~Evnt_timer(50) Do Evnmnt&=Evnt_multi(&X110000,0,0,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),1) If Btst(Evnmnt&,4) ! _Messag Reponse%=@Wmanage(True) ! True: tout g‚rer If Reponse%=-1 ! Au secour!!!! Set_end!=True Else if Reponse%=10 ! PERSO: SWEETEL If (Not Wd_do!) And Set_system&=0 Gosub Msg_bra(Evnmnt&,Reponse%,False,False,False,False,False) ! Idem Else Void Menu_tnormal(Menu_adr%,Wmenu&(3),1) Endif Endif Endif ' ~Evnt_timer(100) Loop until Btst(Evnmnt&,5) ! Until timer (plus de messages) ' Return ' ' '`'`'`'`'`'`'`'`'`'` ' ..Wind update avec controle, si parametre=-1, mode retourn‚ Function Wind_update01(Reponse%) $F% If Reponse%=0 If Actuel_wu%=1 Actuel_wu%=0 ~Wind_update(0) ! End_update ~Wind_update(2) ! End_mctrl Else Return True Endif ' Else if Reponse%=1 If Actuel_wu%=0 Actuel_wu%=1 ~Wind_update(1) ! Beg_update ~Wind_update(3) ! Beg_mctrl Else Return True Endif ' Else if Reponse%=-1 ! Ask Return Actuel_wu% Endif Return 0 Endfunc ' ' ..Titre de fenˆtre #X,T$ Function Titlew(Index&,T$) $F% Local Loop_& If Btst(Wflag%(Index&),0) If Wtitle%(Index&)>0 T$=Left$(T$,125) T$=T$+Mki$(0) For Loop_&=1 To Len(T$) Poke Wtitle%(Index&)+Loop_&-1,Asc(Mid$(T$,Loop_&,1)) Next Loop_& If Wopen!(Index&) If @Tstwork(Index&) ! Non smaller If Btst(Wflag%(Index&),0) ~Wind_set(Whandle&(Index&),2,Card(Swap(Wtitle%(Index&))),Card(Wtitle%(Index&)),0,0) Endif Endif Endif Else Return -1 Endif Else Return -1 Endif Return 0 Endfunc ' ' ..Info de fenˆtre #X,T$ Function Infow(Index&,T$) $F% ' If Index&=4 If Len(T$)=0 T$=Inf4$ T$=" | "+Chr$(9)+" "+Time$+" | "+T$ Else if Swt&=1 Inf4&=2 Inf4$=T$ T$=" "+Chr$(3)+" | "+Chr$(9)+" "+Time$+" | "+T$ Else if Swt&=2 Inf4&=2 Inf4$=T$ T$=" "+Chr$(4)+" | "+Chr$(9)+" "+Time$+" | "+T$ Else if Left$(T$,1)="/" Inf4&=2 T$=Mid$(T$,2) Inf4$=T$ T$=" "+Chr$(4)+" | "+Chr$(9)+" "+Time$+" | "+T$ Else Inf4&=2 Inf4$=T$ T$=" | "+Chr$(9)+" "+Time$+" | "+T$ Endif If Inf4&>0 Dec Inf4& Endif Endif ' If Btst(Wflag%(Index&),4) If Winfo%(Index&)>0 ' T$=T$+Mki$(0) If Len(T$)>127 T$=Left$(T$,125)+Mki$(0) Endif ' ' For Loop_&=1 To Len(T$) ' Poke Winfo%(Index&)+Loop_&-1,Asc(Mid$(T$,Loop_&,1)) ' Next Loop_& ' If Len(T$)>0 Bmove Varptr(T$),Winfo%(Index&),Min(Len(T$),253) Endif ' If Wopen!(Index&) If @Tstwork(Index&) ! Non smaller If Btst(Wflag%(Index&),4) ~Wind_set(Whandle&(Index&),3,Card(Swap(Winfo%(Index&))),Card(Winfo%(Index&)),0,0) Endif Endif Endif Else Return -1 Endif Else Return -1 Endif Return 0 Endfunc ' ' '`'`'`'`'`'`'`'`'`'` ' ..Smaller pour la fenˆtre #Index, Flag! False si conserver dimS Procedure Smaller(Index&,Flag!) Local A&,T%,W&,H&,Modify! ' Modify!=(And(Wxflag%(Index&),&X110)<>0) T%=Wflag%(Index&) If Not Modify! ' Enregistrer ancien flag! Wxflag%(Index&)=Or(Word(Wxflag%(Index&)),Rol(T%,16)) Wflag%(Index&)=&X1101 W_dima(Wflag%(Index&),W&,H&) ! Calculer dims attributs If Flag! W_fx&(Index&)=W_ex&(Index&) W_fy&(Index&)=W_ey&(Index&) W_fw&(Index&)=W_ew&(Index&) W_fh&(Index&)=W_eh&(Index&) W_ex&(Index&)=Min(X_desk&+W_desk&-16,Max(X_desk&,W_fx&(Index&)+W_fw&(Index&)\2-140)) W_ey&(Index&)=Min(Y_desk&+H_desk&-16,Max(Y_desk&,W_fy&(Index&)+W_fh&(Index&)\2-21)) Endif W_ew&(Index&)=72+W& W_eh&(Index&)=58+H& Wxflag%(Index&)=Bset(Wxflag%(Index&),1) ~Wind_set(Whandle&(Index&),26,W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&)) ~Wind_get(Whandle&(Index&),26,T%,A&,A&,A&) If Aesv%<&H400 ! AES < 4.0 ~@Wind_reopen(Index&) Endif Gosub W_calc(Index&) ! recalculer coords! Else Wxflag%(Index&)=Bclr(Bclr(Wxflag%(Index&),1),2) ' R‚cup‚rer ancien flag dans mot fort de Wxflag! Wflag%(Index&)=Word(Swap(Wxflag%(Index&))) W_ex&(Index&)=W_fx&(Index&) W_ey&(Index&)=W_fy&(Index&) W_ew&(Index&)=W_fw&(Index&) W_eh&(Index&)=W_fh&(Index&) ~Wind_set(Whandle&(Index&),27,W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&)) ~Wind_get(Whandle&(Index&),26,T%,A&,A&,A&) If Aesv%<&H400 ! AES < 4.0 ~@Wind_reopen(Index&) Endif Gosub W_calc(Index&) ! recalculer coords! Endif ' If Not Flag! If Not Wopen!(Index&) If Whandle&(Index&)<0 ! not created? ~@Wind_create(Index&) Endif If Whandle&(Index&)=>0 ! Ouverture! Wmove(0,0,1,1,W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&)) ~Wind_open(Whandle&(Index&),W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&)) ~Wind_get(Whandle&(Index&),5,W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&)) ~Wind_get(Whandle&(Index&),4,W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) ~Wind_calc(1,Wflag%(Index&),W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&),W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) W_attrw&(Index&)=W_ew&(Index&)-W_iw&(Index&) W_attrh&(Index&)=W_eh&(Index&)-W_ih&(Index&) Wopen!(Index&)=True Endif Endif Endif @Test_menu ! perso PERSO ' Return ' Procedure Desmall(Index&) If And(Wxflag%(Index&),&X110)<>0 Wxflag%(Index&)=Bclr(Bclr(Wxflag%(Index&),1),2) ' R‚cup‚rer ancien flag dans mot fort de Wxflag! Wflag%(Index&)=Word(Swap(Wxflag%(Index&))) W_ex&(Index&)=W_fx&(Index&) W_ey&(Index&)=W_fy&(Index&) W_ew&(Index&)=W_fw&(Index&) W_eh&(Index&)=W_fh&(Index&) Endif @Test_menu ! perso PERSO Return ' ' '`'`'`'`'`'`'`'`'`'` ' ' ..Echange A et B, A Topped Procedure Swapw(A&,B&) Local X&,Y&,W&,H& ' If Wopen!(A&) And Wopen!(B&) If Not @Tstwork(A&) Gosub Smaller(A&,True) ! UnSmaller Endif If Not @Tstwork(B&) Gosub Smaller(B&,True) ! UnSmaller Endif ' X&=W_ex&(A&) Y&=W_ey&(A&) W&=W_ew&(A&) H&=W_eh&(A&) Gosub Setxywh(A&,W_ex&(B&),W_ey&(B&),W_ew&(B&),W_eh&(B&)) Gosub Setxywh(B&,X&,Y&,W&,H&) Gosub Top(A&) Endif Return ' ' '`'`'`'`'`'`'`'`'`'` ' ' ..Calculer les coordonn‚es attributs Procedure W_dima(X&,Var W3&,H3&) Local A&,W&,H&,W2&,H2& ' ~Wind_calc(1,X&,A&,A&,W&,H&,A&,A&,W2&,H2&) W3&=W&-W2& H3&=H&-H2& Return ' ' ..Recalculer les coordonn‚es internes/externes Procedure W_calc(Index&) ~Wind_get(Whandle&(Index&),5,W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&)) ~Wind_get(Whandle&(Index&),4,W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) W_attrw&(Index&)=W_ew&(Index&)-W_iw&(Index&) W_attrh&(Index&)=W_eh&(Index&)-W_ih&(Index&) Return ' ' '`'`'`'`'`'`'`'`'`'` ' ..Fenˆtre #X au premier plan. (Topped) Procedure Top(Index&) @Xtop(Index&) If Wopen!(Index&) If Not @Tstwork(Index&) Gosub Smaller(Index&,True) ! UnSmaller Endif Endif Gosub W_rdexe Return ' ..Fenˆtre #X au premier plan. (Sous routine interne) Procedure Xtop(Index&) If Index&=>0 ~@Wind_open(Index&) If Index&<>Nombre_w&-1 ! perso If Wopen!(Index&) If Whandle&(Index&)=>0 ' ' Attention! Propre … Sweetel !! If Menu_adr%>0 If Lastw&<>Ha& If Not @Menu_oqp ! menu non oqp? (select) Lastw&=Ha& Gosub Add_menu(Ha&) If Ha&=4 Rdw_all(4) Endif Endif Endif Endif ' ~Wind_set(Whandle&(Index&),10,0,0,0,0) Endif Endif Endif Endif Return ' ' ..Changer coord de fenˆtre #A: XYWH, verifie l'intervalle. Procedure Setxywh(Index&,X&,Y&,W&,H&) ' ' X&=Max(X&,X_desk&) Y&=Max(Y&,Y_desk&) If Btst(Wxflag%(Index&),0) W&=Min(W&,Max_w%(Index&)+W_attrw&(Index&)) H&=Min(H&,Max_h%(Index&)+W_attrh&(Index&)) Endif If @Tstwork(Index&) ! Non smaller W&=Max(W&,120) H&=Max(H&,32) Endif If W_ex&(Index&)<>X& Or W_ey&(Index&)<>Y& Or W_ew&(Index&)<>W& Or W_eh&(Index&)<>H& Wmove(W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&),X&,Y&,W&,H&) W_ex&(Index&)=X& W_ey&(Index&)=Y& W_ew&(Index&)=W& W_eh&(Index&)=H& ~Wind_set(Whandle&(Index&),5,X&,Y&,W&,H&) ~Wind_calc(1,Wflag%(Index&),W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&),W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) W_attrw&(Index&)=W_ew&(Index&)-W_iw&(Index&) W_attrh&(Index&)=W_eh&(Index&)-W_ih&(Index&) Start_x%(Index&)=@W_hslnorm(Index&,Start_x%(Index&)) Start_y%(Index&)=@W_vslnorm(Index&,Start_y%(Index&)) Wsetsl(Index&) Endif Return ' ' ..Changer dimensions max de la fenˆtre #A Procedure Setmaxwh(Index&,W&,H&) If Btst(Wxflag%(Index&),0) Max_w%(Index&)=W& Max_h%(Index&)=H& Else Max_w%(Index&)=W_desk& Max_h%(Index&)=H_desk& Endif Setxywh(Index&,W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&)) Return ' ' ..Changer flags de la fenˆtre #A Procedure Setflag(Index&,X&) Local Y& Wflag%(Index&)=X& ~Wind_set(Whandle&(Index&),1,X&,Y&,Y&,Y&) ~Wind_get(Whandle&(Index&),5,W_ex&(Index&),W_ey&(Index&),W_ew&(Index&),W_eh&(Index&)) ~Wind_get(Whandle&(Index&),4,W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) W_attrw&(Index&)=W_ew&(Index&)-W_iw&(Index&) W_attrh&(Index&)=W_eh&(Index&)-W_ih&(Index&) Start_x%(Index&)=@W_hslnorm(Index&,Start_x%(Index&)) Start_y%(Index&)=@W_vslnorm(Index&,Start_y%(Index&)) Wsetsl(Index&) Gosub Drawx(Index&) Return ' ' '`'`'`'`'`'`'`'`'`'` ' ..V‚rifier l'intervalle de X pour les sliders de la fenˆtre #A. Function W_hslnorm(Index&,X%) $F% X%=Min(X%,Max_w%(Index&)-W_iw&(Index&)) X%=Max(X%,0) ! Pas d'offsets n‚gatifs Return X% Endfunc Function W_vslnorm(Index&,X%) $F% X%=Min(X%,Max_h%(Index&)-W_ih&(Index&)) X%=Max(X%,0) ! Pas d'offsets n‚gatifs Return X% Endfunc ' ' '`'`'`'`'`'`'`'`'`'` ' ..Fenˆtre #A aux coord maximales Procedure Setfulled(Index&) Local W&,H& ' ' Fullable? (...) If (Btst(Wflag%(Index&),2) Or Btst(Wxflag%(Index&),2)) And Not Btst(Wxflag%(Index&),1) If Btst(Wxflag%(Index&),0) W&=Min(W_desk&,Max_w%(Index&)+W_attrw&(Index&)) H&=Min(H_desk&,Max_h%(Index&)+W_attrh&(Index&)) Else W&=W_desk& H&=H_desk& Endif ' ..Prochaines coord fuller au max? If W_fx&(Index&)=X_desk& And W_fy&(Index&)=Y_desk& And W_fw&(Index&)=W& And W_fh&(Index&)=H& ' ..Ce n'est pas deja la cas? If W_ex&(Index&)<>X_desk& Or W_ey&(Index&)<>Y_desk& Or W_ew&(Index&)<>W& Or W_eh&(Index&)<>H& W_fx&(Index&)=W_ex&(Index&) W_fy&(Index&)=W_ey&(Index&) W_fw&(Index&)=W_ew&(Index&) W_fh&(Index&)=W_eh&(Index&) @Setxywh(Index&,X_desk&,Y_desk&,W&,H&) Endif ' ..Prochaines coord fuller pas au max Else ' ..Est-on deja au max (alors retrouver etat anterieur) If (W_ex&(Index&)=X_desk& And W_ey&(Index&)=Y_desk& And W_ew&(Index&)=W& And W_eh&(Index&)=H&) @Setxywh(Index&,W_fx&(Index&),W_fy&(Index&),W_fw&(Index&),W_fh&(Index&)) W_fx&(Index&)=X_desk& W_fy&(Index&)=Y_desk& W_fw&(Index&)=W& W_fh&(Index&)=H& Else ' ..Non, alors maximum! W_fx&(Index&)=W_ex&(Index&) W_fy&(Index&)=W_ey&(Index&) W_fw&(Index&)=W_ew&(Index&) W_fh&(Index&)=W_eh&(Index&) @Setxywh(Index&,X_desk&,Y_desk&,W&,H&) Endif Endif Endif @Test_menu ! perso PERSO Return ' ' ..Plein ‚cran! - NB: Utilise les mˆmes vecteurs que le smaller. Procedure Setfscreen(Index&) Local T%,Modify! ' If Btst(Wflag%(Index&),2) Or Btst(Wxflag%(Index&),2) If Not Btst(Wxflag%(Index&),1) Modify!=Btst(Wxflag%(Index&),2) T%=Wflag%(Index&) ~@Wind_close(Index&) If Modify!=False ' Enregistrer ancien flag! Wxflag%(Index&)=Or(Word(Wxflag%(Index&)),Rol(T%,16)) Wflag%(Index&)=&X0 ! aucun ttributs! W_fx&(Index&)=W_ex&(Index&) W_fy&(Index&)=W_ey&(Index&) W_fw&(Index&)=W_ew&(Index&) W_fh&(Index&)=W_eh&(Index&) W_ex&(Index&)=X_desk& W_ey&(Index&)=Y_desk& W_ew&(Index&)=W_desk& W_eh&(Index&)=H_desk& ~@Wind_open(Index&) Wxflag%(Index&)=Bset(Wxflag%(Index&),2) Else Wxflag%(Index&)=Bclr(Wxflag%(Index&),2) ' R‚cup‚rer ancien flag dans mot fort de Wxflag! Wflag%(Index&)=Word(Swap(Wxflag%(Index&))) W_ex&(Index&)=W_fx&(Index&) W_ey&(Index&)=W_fy&(Index&) W_ew&(Index&)=W_fw&(Index&) W_eh&(Index&)=W_fh&(Index&) If Index&=0 ! perso ! Start_x%(0)=0 Start_y%(0)=0 Endif ~@Wind_open(Index&) Endif Endif ! non smaller! Endif ' @Test_menu ! perso PERSO ' Return ' ' ' ..Produire effet de d‚placementde boite de XYWH … X2Y2W2H2 Procedure Wmove(X&,Y&,W&,H&,X2&,Y2&,W2&,H2&) If Effect! If W&=W2& And H&=H2& ~Graf_movebox(W&,H&,X&,Y&,X2&,Y2&) Else if W&>W2& And H&>H2& ~Graf_shrinkbox(X2&,Y2&,W2&,H2&,X&,Y&,W&,H&) ! invers‚! Else if W&A& ~Wind_set(Whandle&(Index&),8,T&,0,0,0) Endif T&=(W_iw&(Index&)*1000)\Max(1,Max_w%(Index&)) ~Wind_get(Whandle&(Index&),15,A&,Dummy&,Dummy&,Dummy&) If T&<>A& ~Wind_set(Whandle&(Index&),15,T&,0,0,0) Endif Endif If Btst(Wflag%(Index&),8) T&=(Start_y%(Index&)*1000)\Max(1,(Max_h%(Index&)-W_ih&(Index&))) ~Wind_get(Whandle&(Index&),9,A&,Dummy&,Dummy&,Dummy&) If T&<>A& ~Wind_set(Whandle&(Index&),9,T&,0,0,0) Endif T&=(W_ih&(Index&)*1000)\Max(1,Max_h%(Index&)) ~Wind_get(Whandle&(Index&),16,A&,Dummy&,Dummy&,Dummy&) If T&<>A& ~Wind_set(Whandle&(Index&),16,T&,0,0,0) Endif Endif Endif Return ' ' ..Faire en sorte que la coordonn‚e XY soit visible dans la fenˆtre Index Procedure Wshowme(Index&,X%,Y%) If Whandle&(Index&)=>0 If @Wxacoord(Index&,X%)>W_ix&(Index&)+W_iw&(Index&) Or @Wxacoord(Index&,X%)Pts% ! Modifi‚e? Start_x%(Index&)=Pts% ! Alors ‚crire nouveau W_Ax Wsetsl(Index&) ! Modifier sliders Gosub Drawx(Index&) Gosub Rd_all(Index&,W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) Endif Endif If @Wyacoord(Index&,Y%)=>W_iy&(Index&)+W_ih&(Index&) Or @Wyacoord(Index&,Y%)<=W_iy&(Index&) Pts%=Y%-Div(W_ih&(Index&),2) ! Ajout en Y Pts%=@W_vslnorm(Index&,Pts%) ! V‚rifier l'intervalle Verticale If Start_y%(Index&)<>Pts% ! Modifi‚e? Start_y%(Index&)=Pts% ! Alors ‚crire nouveau W_Ay Wsetsl(Index&) ! Modifier sliders Gosub Drawx(Index&) Gosub Rd_all(Index&,W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) Endif Endif Endif Return ' ' ..Tester si la coordonn‚e XY est visible dans la fenˆtre Index Function Tstshow(Index&,X%,Y%) $F% If Whandle&(Index&)=>0 If @Wxacoord(Index&,X%)>W_ix&(Index&)+W_iw&(Index&)+1 Or @Wxacoord(Index&,X%)W_iy&(Index&)+W_ih&(Index&)+1 Or @Wyacoord(Index&,Y%)<=W_iy&(Index&) Return False Endif Endif Return True Endfunc ' ' ' '`'`'`'`'`'`'`'`'`'` ' ..D‚termine … quel index est li‚ ce handle *X (-1 si non trouv‚) Function Windex(Handle&) $F% Local Loop_& For Loop_&=0 To Nbr_idxw& If Whandle&(Loop_&)=Handle& Exit if True Endif Next Loop_& If Loop_&>Nbr_idxw& Return -1 Else Return Loop_& Endif ' Endfunc ' ' ..D‚termine le nombre de fenˆtres ouvertes Function Wexist $F% Local Loop_&,X& ' X&=0 For Loop_&=0 To Nbr_idxw& If Wopen!(Loop_&) Inc X& Endif Next Loop_& Return X& Endfunc ' ' ..D‚termine quelle fenˆtre est au 1er plan, -1=aucune Function Firstw $F% Local Y& ' Y&=@Xfirstw If Y&=>0 If @Tstwork(Y&)=False ! Smaller... Y&=-1 Endif Endif Return Y& ' Endfunc ' ..D‚termine quelle fenˆtre est au 1er plan absolu (interne) Function Xfirstw $F% Local A&,Y&,X&,Loop_& ' A&=False For Loop_&=0 To Nbr_idxw& If Wopen!(Loop_&) A&=True Endif Next Loop_& ' If A&=True ~Wind_get(Whandle&(0),10,A&,Y&,Y&,X&) Y&=@Windex(A&) Else Y&=True ! plus de fenˆtres! Endif ' Return Y& Endfunc ' ' ..PremiŠre fenŠtre non smalled Function Firstns $F% Local Y&,Loop_& ' Y&=-1 For Loop_&=0 To Nbr_idxw& If Wopen!(Loop_&) If Not Btst(Wxflag%(Loop_&),1) ! Not smaller Y&=Loop_& Exit if True Endif Endif Next Loop_& ' Return Y& Endfunc ' ' ..Fenˆtre #Index apte a travailler? Function Tstwork(Index&) $F% If Wopen!(Index&) Return Not Btst(Wxflag%(Index&),1) Else Return False Endif Endfunc ' ' ..D‚termine l'index de la prochaine fenˆtre … partir de A. -1 si non trouv‚ Function Nextw(Index&) $F% Local X& ' If Index&<0 Clr Index& Endif X&=Index&+1 ' While X&<>Index& And X&<>True If Wopen!(X&) And Not Btst(Wxflag%(X&),1) If X&<>Nbr_idxw& ! PERSO !!! Index&=X& X&=True Else Inc X& Endif Else Inc X& Endif If X&>Nbr_idxw& Clr X& Endif Wend If X&=True Return Index& Else Return True Endif ' Endfunc ' ' ..D‚termine si la fenˆtre X est au 1er plan: V/F Function Wtestop(Index&) $F% Local Reponse%,Y& ~Wind_get(Whandle&(Index&),10,Reponse%,Y&,Y&,Y&) If Reponse%=Whandle&(Index&) Return True Endif Return False Endfunc ' ' '`'`'`'`'`'`'`'`'`'` ' ..D‚termine si la coordonn‚e relative XY ' est visible dans la fenˆtre A: V/F (attention aux offsets) Function Wrvisible(Index&,X%,Y%) $F% X%=@Wxacoord(Index&,X%) Y%=@Wyacoord(Index&,Y%) Return @Wavisible(Index&,X%,Y%) Endfunc ' ' ..D‚termine si la coordonn‚e absolue XY ' est visible dans la fenˆtre A: V/F Function Wavisible(Index&,X%,Y%) $F% If X%=>W_ix&(Index&) And Y%=>W_iy&(Index&) If X%<=W_ix&(Index&)+W_iw&(Index&) And Y%<=W_iy&(Index&)+W_ih&(Index&) Return True Endif Endif Return False Endfunc ' ' ' '`'`'`'`'`'`'`'`'`'`Wind-FormInput'`'`'`'`'`'`'`'`'`'` ' ..Redraw pour Do_winput [I] Procedure Do_wredraw(Index&) Wdobox(Index&,True) Return ' ' ..Curseur dans WDo_input [I] C: True/False Procedure Wdobox(Index&,C&) Local X%,Y% ' If Wopen!(Index&) @Lhidem X%=@Wxacoord(Index&,Dw_x%(Index&))+Dwx_&(Index&)*Ccsizex&-Ccsizex& Y%=@Wyacoord(Index&,Dw_y%(Index&))-Ccsizey& Graphmode (1) Gosub Deffillcol(Colg&) Gosub Color(Colg&) Select And(Dwf_&(Index&),&HF0) Case &HF0 If And(Dwf_&(Index&),&HF)=&H0 ' Full box Gosub Deffillcol(Colg&) If C&=False Gosub Deffillcol(0) Else Bndary(0) Graphmode (3) Endif Pbox X%,Y%+1,X%+Ccsizex&,Y%+Ccsizey& Else ' Empty box If C&=False Gosub Deffillcol(0) Else ' Graphmode 3 Endif Pbox X%,Y%+1,X%+3,Y%+Ccsizey& Endif Case &H0 If And(Dwf_&(Index&),&HF)=&H0 ' Half box Gosub Deffillcol(Colg&) If C&=False Gosub Deffillcol(0) Else Bndary(0) Graphmode (3) Endif Pbox X%,Y%+Ccsizey&\2,X%+Ccsizex&,Y%+Ccsizey& Else ' UnderLine Gosub Color(Colg&) If C&=False Gosub Color(0) Else ' Graphmode 3 Endif Line X%,Y%+Ccsizey&+1,X%+Ccsizex&,Y%+Ccsizey&+1 Line X%,Y%+Ccsizey&,X%+Ccsizex&,Y%+Ccsizey& Endif Endselect Graphmode (1) ' If Dwx_&(Index&)>0 If C&=0 If Index&=0 And Sgn(Sb&+Eb&)>0 ' Y%=Max(0,Dw_y%(Index&)) Div Y%,Ccsizey& If Y%=>Sb&+1 And Y%<=Eb&+1 Gosub Deftext(2,&X10) Endif Wtext(Index&,Dw_x%(Index&)+Dwx_&(Index&)*Ccsizex&-Ccsizex&,Dw_y%(Index&),Mid$(Dw_$(Index&),Dwx_&(Index&),1)) If Y%=>Sb&+1 And Y%<=Eb&+1 Gosub Deftext(Col1&,0) Endif ' Else ' Wtext(Index&,Dw_x%(Index&)+Dwx_&(Index&)*Ccsizex&-Ccsizex&,Dw_y%(Index&),Mid$(Dw_$(Index&),Dwx_&(Index&),1)) Endif Endif ' Endif @Lshowm Endif ' Return ' ' ..Changer type de curseur: True ou False Procedure Wsetcurs(Index&,C&) Wdobox(Index&,False) Dwf_&(Index&)=Or(And(Dwf_&(Index&),&HF),And(C&,&HF0)) Wdobox(Index&,True) Return ' ' ..Replace ou Insert? (0/-1) Procedure Wsetcm(Index&,C&) Wdobox(Index&,False) Dwf_&(Index&)=Or(And(Dwf_&(Index&),&HF0),And(C&,&HF)) Wdobox(Index&,True) Return ' ' ..Replace ou Insert? (0/-1) Deffn Wtc(Index&)=((And(Dwf_&(Index&),&HF))=&HF) ' ' ..Initialiser paramŠtres de Do_winit. Procedure Do_winit(Index&,X%,Y%,T$) Dw_x%(Index&)=X% Dw_y%(Index&)=Y% Dw_$(Index&)=T$ If Len(T$)>0 Dwx_&(Index&)=Len(T$)+1 Else Dwx_&(Index&)=0 Endif Return ' ' ..Effacer cette entr‚e Procedure Do_wclr(Index&) Dw_$(Index&)="" Return ' ' ..D‚truire cette entr‚e Procedure Do_wkill(Index&) Dwx_&(Index&)=0 Dw_x%(Index&)=0 Dw_y%(Index&)=0 Dw_$(Index&)="" Return ' ' ..Entr‚e de texte dans #A en XY relatifs, traiter caractŠre C dans ' T$, longueur renvoy‚e dans Len. Maxl: nombre maximum de caractŠres. ' A: Index ' X: Position X de l'entr‚e en relatif, -1 si ne doit pas changer ' Y: Idem, -1 si doit rester inchang‚ (aprŠs un WInit) ' C: CaractŠre … traiter ' T$: Chaine ' Retour: longueur de chaine ou -1 si termin‚. ' ' Touches accept‚es: Bkspace,Del,Insert,^Enter,^T (tronquer),^U (upper) ' ^B (change cursor), fleches, ^fleches droite/gauche ' esc/^Y,^Del (effacer). ' Insert: commute replace/insert ' ^B : forme du curseur Function Do_winput(Index&,X%,Y%,C&,Maxl&,Var T$) $F% Local Ha&,Formx&,Formy&,Formw&,Formh& ! Var locale! ' If C&=200 Or C&=208 ~Graf_mkstate(Formx&,Formx&,Formx&,Formy&) If Btst(Formy&,2) C&=C&+1000 Endif Endif ' Gosub Deftextcol(Col1&) ' If X%=True X%=Dw_x%(Index&) Endif If Y%=True Y%=Dw_y%(Index&) Endif ' ..V‚rifier si le curseur est visible, et au besoin l'ajuster! Wshowme(Index&,X%+Dwx_&(Index&)*Ccsizex&,Y%) ' ..Effacer curseur, tester paramŠtres Clip(W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) Wdobox(Index&,False) If C&<>-1 If Dw_x%(Index&)<>X% Or Dw_y%(Index&)<>Y% Or Dw_$(Index&)<>T$ If Wopen!(Index&) Wtext(Index&,Dw_x%(Index&),Dw_y%(Index&),Space$(Len(Dw_$(Index&)))) Wtext(Index&,X%,Y%,T$) Endif Endif Endif Dw_x%(Index&)=X% Dw_y%(Index&)=Y% Dwx_&(Index&)=Max(Dwx_&(Index&),1) ' ' ..Traiter caractŠre! Select C& Case 8 ! bkspc If Len(T$)>0 And Dwx_&(Index&)>1 If Wopen!(Index&) Wtext(Index&,X%,Y%,Space$(Len(T$))) Endif Dec Dwx_&(Index&) If @Wtc(Index&)=0 Mid$(T$,Dwx_&(Index&))=Chr$(32) ' Else ! Insert T$=Left$(T$,Dwx_&(Index&)-1)+Mid$(T$,Dwx_&(Index&)+1) Endif Endif Gosub Videkbd2 Case 127 If Len(T$)>0 If Wopen!(Index&) Wtext(Index&,X%,Y%,Space$(Len(T$))) Endif T$=Left$(T$,Dwx_&(Index&)-1)+Mid$(T$,Dwx_&(Index&)+1) Endif Gosub Videkbd2 Case 13,208,200,1200,1208,10,225,21,247,26,4,21 ! Cr,\/,^ etc Gosub Videkbd2 Return -C& ! Fin de saisie Case 203 ! <- ' Gosub Videkbd2 Dwx_&(Index&)=Max(Dwx_&(Index&)-1,1) Clr C& Case 205 ! -> ' Gosub Videkbd2 Dwx_&(Index&)=Min(Dwx_&(Index&)+1,Len(T$)+1) Clr C& Case 9 ! Tab Dwx_&(Index&)=Min((Dwx_&(Index&)\8+1)*8,Len(T$)+1) Clr C& Case 243 ! ^<- Gosub Videkbd Dwx_&(Index&)=1 Clr C& Case 244 ! ^-> Gosub Videkbd Dwx_&(Index&)=Len(T$)+1 Clr C& Case 27,31 ! Esc Gosub Videkbd If Wopen!(Index&) Wtext(Index&,X%,Y%,Space$(Len(T$))) Endif Dwx_&(Index&)=1 Clr T$ Case 18 ! ^R (couper) Gosub Videkbd If Wopen!(Index&) Wtext(Index&,X%,Y%,Space$(Len(T$))) Endif T$=Mid$(T$,1,Dwx_&(Index&)-1) Case 1 ! 1=R‚serv‚ (restaurer curseur, ; ^A) If Wopen!(Index&) Wtext(Index&,X%,Y%,T$+Chr$(32)) Endif Case 29 Wsetcurs(Index&,And(Dwf_&(Index&),&HF0)=&H0) Wdobox(Index&,True) Case 20 ! Tronquer Gosub Videkbd If Wopen!(Index&) Wtext(Index&,X%,Y%,Space$(Len(T$))) Endif T$=Trim$(T$) Dwx_&(Index&)=Min(Dwx_&(Index&)+1,Len(T$)+1) Case 21 ! Majuscules Gosub Videkbd If Wopen!(Index&) Wtext(Index&,X%,Y%,Space$(Len(T$))) Endif T$=Upper$(T$) Case 210 ! Insert Gosub Videkbd Wsetcm(Index&,And(Dwf_&(Index&),&HF)=&H0) Wdobox(Index&,True) Case 0 ! ne rien faire Case 1 To 31 Gosub Videkbd Default If (Len(T$)<=Maxl& Or Dwx_&(Index&)<=Maxl&) ' If @Wtc(Index&)=0 ! Replace ' If Dwx_&(Index&)>Len(T$) T$=T$+Space$(Dwx_&(Index&)-Len(T$)) Endif Mid$(T$,Dwx_&(Index&),1)=Chr$(C&) Inc Dwx_&(Index&) ' Else If Len(T$)-2 If C&<>0 If Wopen!(Index&) Wtext(Index&,X%,Y%,T$) Endif Endif Wdobox(Index&,True) Endif Clip Off Gosub Fdtest ' ' Rev‚rifier les coordonn‚es If @Wxacoord(Index&,X%+Dwx_&(Index&)*Ccsizex&)>W_ix&(Index&)+W_iw&(Index&) Pts%=Start_x%(Index&) ! Ajout en X Add Pts%,W_iw&(Index&)\2 Pts%=@W_hslnorm(Index&,Pts%) ! V‚rifier l'intervalle Horizontale If Start_x%(Index&)<>Pts% ! Modifi‚e? Start_x%(Index&)=Pts% ! Alors ‚crire nouveau W_Ax Wsetsl(Index&) ! Modifier sliders Gosub Drawx(Index&) Gosub Rd_all(Index&,W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) Endif Else if @Wxacoord(Index&,X%+Dwx_&(Index&)*Ccsizex&)Pts% ! Modifi‚e? Start_x%(Index&)=Pts% ! Alors ‚crire nouveau W_Ax Wsetsl(Index&) ! Modifier sliders Gosub Drawx(Index&) Gosub Rd_all(Index&,W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) Endif Endif ' Return Len(Dw_$(Index&)) Endfunc ' '`'`'`'`'`'`'`'`'`'`Fin de Wind_input'`'`'`'`'`'`'`'`'`'` ' ' ..Proc‚dure de gestion clavier 1‚re: ^C (swap) etc.. Function Wkmanage(C&) $F% Local W&,X&,B&,Reponse% ' X&=-1 ! Trait‚ W&=@Xfirstw If W&<>-1 ! -1=aucune au 1er plan Select C& ' Case 14 ! ^N, next window Reponse%=@Nextw(W&) If Reponse%=Nombre_w&-1 Reponse%=@Nextw(Nombre_w&-1) Endif If Reponse%<>-1 Gosub Xtop(Reponse%) ! NewTop Endif Gosub W_rdexe ! On vide le buffer event! (s‚curit‚) Case 6 ! ^F, fulled ' If (Btst(Wflag%(W&),2) Or Btst(Wxflag%(W&),2)) And Not Btst(Wxflag%(W&),1) ! Fullable? (...) Gosub Setfulled(W&) Gosub W_rdexe ! On vide le buffer event! (s‚curit‚) ' Endif Case 11,511 ! ^K fermer, Smaller If (C&=11 And And(@Bios11,&X11)=0) If Btst(Wflag%(W&),1) Or Btst(Wxflag%(W&),1) ! Fermable? ~@Wind_close(W&) Gosub W_rdexe ! On vide le buffer event! (s‚curit‚) Endif ' Else ' If Btst(Wflag%(W&),2) Or Btst(Wxflag%(W&),2) If Not Btst(Wxflag%(W&),1) Gosub Smaller(W&,True) B&=@Firstns If B&=>0 @Xtop(B&) Endif ' Else Gosub Smaller(W&,True) Endif Endif Endif ' Case 2 ! Full screen ' Fullable=FullScreenable (ah le fran‡ais!) - ou bien d‚j… fs ' If Btst(Wflag%(W&),2) Or Btst(Wxflag%(W&),2) Gosub Setfscreen(W&) Gosub W_rdexe ! On vide le buffer event! (s‚curit‚) ' Endif Default Select C& Case 243,244,24,208 B&=@Shift If And(B&,&X1110)=&X110 ! ShiftCtrl+FlŠches If Not Btst(B&,0) If Btst(Wflag%(W&),5) Or Btst(Wxflag%(W&),2) ! Sizeable Select C& Case 243 ! <- Setxywh(W&,W_ex&(W&),W_ey&(W&),Max(Ccsizex&,W_ew&(W&)-Ccsizex&),W_eh&(W&)) Case 244 ! -> Setxywh(W&,W_ex&(W&),W_ey&(W&),Min(W_desk&,W_ew&(W&)+Ccsizex&),W_eh&(W&)) Case 24 ! ^ Setxywh(W&,W_ex&(W&),W_ey&(W&),W_ew&(W&),Max(Ccsizey&,W_eh&(W&)-Ccsizey&)) Case 208 ! \/ Setxywh(W&,W_ex&(W&),W_ey&(W&),W_ew&(W&),Min(H_desk&,W_eh&(W&)+Ccsizey&)) Endselect Endif Else ! Move If Btst(Wflag%(W&),3) Or Btst(Wxflag%(W&),2) ! Moveabe Select C& Case 243 ! <- Setxywh(W&,Max(X_desk&,W_ex&(W&)-Ccsizex&),W_ey&(W&),W_ew&(W&),W_eh&(W&)) Case 244 ! -> Setxywh(W&,Min(X_desk&+W_desk&,W_ex&(W&)+Ccsizex&),W_ey&(W&),W_ew&(W&),W_eh&(W&)) Case 24 ! ^ Setxywh(W&,W_ex&(W&),Max(Y_desk&,W_ey&(W&)-Ccsizey&),W_ew&(W&),W_eh&(W&)) Case 208 ! \/ Setxywh(W&,W_ex&(W&),Min(Y_desk&+H_desk&,W_ey&(W&)),W_ew&(W&),W_eh&(W&)) Endselect Endif Endif Gosub W_rdexe Else X&=C& ! Pas trait‚ Endif Default X&=C& ! Pas trait‚ Endselect Endselect ' Else Select C& Case 6,11,14 Default Clr X& Endselect Endif Return X& ' Endfunc ' ' '`'`'`'`'`'`'`'`'`'` ' ..Cette fonction convertit un caractŠre sur 2 octets en ' un sur 1 octet, comme Inp(2) Function Geminp(A&) $F% ' If Byte(A&)=0 A&=Shr&(A&,8) Add A&,&H80 Endif A&=Byte(A&) Return A& Endfunc ' ' ..Vide buffer clavier Procedure Videkbd While And(Evnt_multi(&X100001,0,0,0,0,0,0,0,0,0,0,0,0,0,0,10),&X1)<>0 Wend While Inp?(2) ~Inp(2) Wend Return Procedure Videkbd2 ' FlŠches non dynamiques? If Not Expert! Videkbd Endif Return ' $P< Procedure Hidem Contrl(0)=123 ! Hide cursor Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=0 Vdisys Return Procedure Showm Contrl(0)=122 ! Show cursor Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=0 Vdisys Return ' Local Hidem/Showm Procedure Lhidem Contrl(0)=123 ! Hide cursor Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=1 ! Non reset Vdisys Return Procedure Lshowm Contrl(0)=122 ! Show cursor Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=1 ! Non reset Vdisys Return $P> ' Procedure Pause(A%) Local T% Mul A%,4 T%=Timer While (Timer-T%) ' '`'`'`'`'`'`'`'`'`'` ' ..Texte T$ dans une fenˆtre #A, en ABSOLU XY Procedure Wtext(Index&,X%,Y%,T$) Local L%,X2% @Lhidem ' "Deftail(Font_tail&) ! SWEETEL X2%=@Wxacoord(Index&,X%) L%=1 If X2%<-Ccsizex& L%=-X2%\Ccsizex& Add X2%,L%*Ccsizex& Inc L% Endif Justext(X2%,@Wyacoord(Index&,Y%),Mid$(T$,L%)) @Lshowm ' Get_csize Return ' Procedure Justext(X%,Y%,E$) Local A& ' ' Contrl(0)=11 ! GDP ' Contrl(1)=2 ' Contrl(3)=Len(E$)+2 ' Contrl(5)=10 ! justified ' Contrl(6)=V~h ' Ptsin(0)=X% ' Ptsin(1)=Y% ' Ptsin(2)=Ccsizex&*Len(E$) ! bah oui!! ' Intin(0)=0 ' Intin(1)=1 ! entre les lettres If Font&=1 ! fonte ROM? Text X%,Y%,E$ Else Gosub Deffillcol(0) ' ' Pbox X%,Y%-Font_dec&,X%+(Len(E$))*Ccsizex&,Y%-Font_dec&+Ccsizey& Gosub Pbox(X%,Y%-Font_tail&,X%+(Len(E$))*Ccsizex&,Y%-Font_tail&+Ccsizey&) For A&=1 To Min(240,Len(E$)) ' Intin(A&+1)=Asc(Mid$(E$,A&,1)) Text X%+Ccsizex&*(A&-1),Y%,Mid$(E$,A&,1) Next A& ' Vdisys ! Call VDI Endif Return ' ' ..Indique dans CcsizeX/Y& la taille d'un caractŠre X (fictif) courant Procedure Get_csize ' " If Set_tail&=Vdt_tail& ' "Deftail(Font_tail&) ' "Endif ' Contrl(0)=117 ! Inquire Character Cell Width Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Vdisys If Ptsout(0)<400 Ccsizex&=Ptsout(0) Else ' Ccsizex&=-1 Endif ' Ccsizex&=@Textlen("A") ' Contrl(0)=38 ! Inquire Current Graphic Text Attributes Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys Font_tail&=Ptsout(1) ! taille fonte! Ccsizey&=Ptsout(3) ' ' Saloperie de SpeedoGdos!! quelle chiotte! ' ' If Ptsout(0)ABSOLU Function Wxacoord(Index&,X%) $F% Sub X%,Start_x%(Index&) Add X%,W_ix&(Index&) Return X% Endfunc Function Wyacoord(Index&,Y%) $F% Sub Y%,Start_y%(Index&) Add Y%,W_iy&(Index&) Return Y% Endfunc ' ' ..Transforme ABSOLU->RELATIF Function Wxrcoord(Index&,X%) $F% Add X%,Start_x%(Index&) Sub X%,W_ix&(Index&) Return X% Endfunc Function Wyrcoord(Index&,Y%) $F% Add Y%,Start_y%(Index&) Sub Y%,W_iy&(Index&) Return Y% Endfunc ' Function Mousek $F% Local A&,X& ~@Graf_mkstate(A&,A&,X&,A&) A&=@Xmousek ! @ÝŠ*(&‚ de GEM !! If X&<>A& ! -> clic Gem <> clic VDI ? X&=A& ! on corrige... (...!!!) Endif Return X& Endfunc Function Xmousek $F% Contrl(0)=124 ! du bon vdi de chez nous Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys Return Intout(0) Endfunc Function Form_alert(N&,A$) $F% ' @Showm ~@Wind_update01(0) ! en update 0!! Return Form_alert(N&,A$) Endfunc Function Graf_mkstate(Var X&,Y&,B&,A&) $F% Local N&,T& ' N&=Graf_mkstate(X&,Y&,B&,A&) T&=@Xmousek If T&<>B& ! grrrrrr!!!! B&=T& ! rectifier (......) Endif Return N& ' Endfunc Procedure Mouse(Var X&,Y&,K&) Contrl(0)=124 ! du bon vdi de chez nous Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys K&=Intout(0) X&=Ptsout(0) Y&=Ptsout(1) Return ' $P< Function Shift $F% Return Bclr(@Bios11,4) Endfunc Function Shiftbrk $F% Return (Bclr(@Bios11,4)=&X11) Endfunc Function Shiftbrk2 $F% If (Bclr(@Bios11,4)=&X11) Gosub Affbrk Return True Else Return False Endif Endfunc $P> Procedure Affbrk Local A& ' Gosub Defmouse(2) A&=@Firstw If A&=>0 ~@Infow(A&,"Interruption enregistr‚e!") Endif @Showm While Bclr(@Bios11,4)=&X11 Wend If A&=>0 @Drawx(A&) Endif Gosub Defmouse(0) Return ' Function Bios11 $F% Contrl(0)=128 Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys Return Intout(0) Endfunc ' ' certains types text et line identiques … ceux du bureau Procedure Iniscr ' Local X&,Y&,Z&,B& ' ' params text Contrl(0)=38 ! inquire current test attributes Contrl(1)=0 Contrl(3)=0 Contrl(6)=Graf_handle() Vdisys B&=Ptsout(1) ! hauteur texte X&=Intout(0) ! fonte actuelle Y&=Intout(1) ! couleur texte Z&=Intout(5) ! effets ' Contrl(0)=12 ! Set character height, am Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=B& ! hauteur desktop Vdisys Gosub Deftextattrb(&X0) ' Contrl(0)=21 ! set text face Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=X& ! fonte desktop Vdisys ' Contrl(0)=22 ! set graphics text color index Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=Y& ! couleur text desktop Vdisys ' ' Contrl(0)=106 ! set gt special effets Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=0 ! effets normaux! Vdisys ' ' params line Contrl(0)=35 ! inquire current polyline attributes Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys X&=Intout(0) ! type poly Y&=Intout(1) ! couleur poly ' Contrl(0)=15 ! set polyline line type Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=X& ! type line desktop Vdisys ' ' Contrl(0)=17 ! sp color index Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=Y& ! couleur desk Vdisys ' ' Return ' Function Malloc(M%) ! Sysmalloc $F% Local Adr% Adr%=Gemdos(72,L:M%) If M%>0 If Adr%>0 Malloc$=Malloc$+Mkl$(Adr%)+Mkl$(M%) ' Print "Allocating and clearing "+Str$(M%)+" bytes in buffer #"+Hex$(Adr%,8)+" at "+Time$+" tot ";+Len(Malloc$)\8 ~C:Clrblk%(L:Adr%,L:M%) ! effacer Endif Endif Return Adr% Endfunc Function Mfree(Var M%) $F% Local A% Local A& ' If M%>0 A&=1 While A&<=Len(Malloc$) If Cvl(Mid$(Malloc$,A&,4))=M% ' Print "UnAllocating "+Str$(Cvl(Mid$(Malloc$,A&+4,4)))+" bytes in buffer #"+Hex$(M%,8)+" tot ";+(Len(Malloc$)-8)\8 Malloc$=Left$(Malloc$,A&-1)+Mid$(Malloc$,A&+8) A&=-1 Exit if True Endif Add A&,8 Wend If A&<>-1 ' Print "UnAllocating buffer #"+Hex$(M%,8)+" tot ";+(Len(Malloc$)-8)\8 ' Print "-> Mfree Error! Unknown buffer! #"+Hex$(M%,8) ~@Form_alert(1,"[3][Contr“le m‚moire Sweetel|Un bloc a disparu en $"+Hex$(M%,8)+"|Il se peut qu'une erreur |se soit produite][Not‚]") Endif ' A%=Mfree(M%) Endif M%=-1 ' Return A% Endfunc Procedure Mxfree Local A& ' If Len(Malloc$)>0 For A&=1 To Len(Malloc$) Step 8 ~Mfree(Cvl(Mid$(Malloc$,A&,4))) Next A& Clr Malloc$ Endif ' Return ' ' Screen copy Procedure Scr_copy(X&,Y&,W&,H&,X2&,Y2&) ' @Lhidem If Y&+H&<=Work_out(1)+1 ' Note: G_D%()=0 ' R_d%(0)=X& ! position d‚part X R_d%(1)=Y& ! position d‚part Y R_d%(2)=X&+W&-1 ! position d‚part X2 R_d%(3)=Y&+H&-1 ! position d‚part Y2 R_d%(4)=X2& ! destination X R_d%(5)=Y2& ! destination Y R_d%(6)=X2&+W&-1 ! destination W R_d%(7)=Y2&+H&-1 ! destination H R_d%(8)=3 ! mode de combinaison normal ' ' rus‚ le STS: G_D to G_D (vide->vide = screen->screen!!) Bitblt G_screen%(),G_screen%(),R_d%() ! Vdi Raster Copy ; Opaque (VDI) Endif ! pas ‚x‚cut‚ si paramŠtres incorrects @Lshowm ' Return ' ' ' ' Gestion des popups ' (c)1995 Xavier ROCHE ' ' Popups classiques, barres -------- gris‚es transparentes: ' ' Choix1 -> Id 1 Id interne 1 (Xstr_pop$ par exemple) ' ------ Id interne 2 ' Choix2 -> Id 2 Id interne 3 ' ' ' Procedure Popinit Dim Pop$(31) ! xxx|yyy.. Dim Popa%(31) ! ressource adr Dim Popo&(31) ! obj no Npop&=0 Charsz&=8 ! largeur d'un caractŠre RSC Hsize&=Ob_h(Adrpop%,0)/10 ! hauteur (10 entr‚es) Return Procedure Popuninit Erase Pop$(),Popa%(),Popo&() Return ' Procedure Popset(Adr%) Local O& ' Clr O& Do If Ob_type(Adr%,O&)=26 ! button If Byte{Ob_spec(Adr%,O&)}=Asc("[") ! [bouton|..] Pop$(Npop&)=Char{Ob_spec(Adr%,O&)} ! noter texte Pop$(Npop&)=Mid$(Pop$(Npop&),2,Len(Pop$(Npop&))-2) ! couper [] Popa%(Npop&)=Adr% ! adresse arbre Popo&(Npop&)=O& ! objet Char{Ob_spec(Adr%,O&)}=@Str_pop$(Pop$(Npop&),1) ! virtuel Ob_w(Adr%,O&)=(4+@Len_pop(Pop$(Npop&)))*Charsz& ! taille Inc Npop& ' Endif Endif Inc O& Loop until Btst(Ob_flags(Adr%,O&),5) ! lastob Return ' Function Form_newdo(Adr%,O&) $F% Local F% Local A& Local P! ' Do F%=Form_do(Adr%,O&) ' ' Popup? P!=True For A&=0 To Npop&-1 If Popa%(A&)=Adr% If Popo&(A&)=Byte(F%) P!=False ' Char{Ob_spec(Adr%,Byte(F%))}=@Str_pop$(Pop$(A&),@Popdial(A&)) Ob_state(Adr%,Byte(F%))=Bclr(Ob_state(Adr%,Byte(F%)),0) ~Objc_draw(Adr%,Byte(F%),7,Ob_x(Adr%,0),Ob_y(Adr%,0),Ob_w(Adr%,0),Ob_h(Adr%,0)) ' Endif Endif Next A& ' Loop until P! ' Return F% Endfunc Function Popdial(N&) $F% Local X&,Y&,W&,H& Local A&,B&,C&,D& Local Mx&,My&,Mk& Local E$ Local E&,F&,G&,I& Local P& ! old ' ~Objc_offset(Popa%(N&),Popo&(N&),X&,Y&) D&=@No_pop(Pop$(N&),Char{Ob_spec(Popa%(N&),Popo&(N&))}) P&=D& ' id physique Sub Y&,(@Xno_pop(Pop$(N&),Char{Ob_spec(Popa%(N&),Popo&(N&))})-1)*Hsize& C&=@Len_pop(Pop$(N&)) W&=(4+C&)*Charsz& B&=@Nmax_pop(Pop$(N&)) ! entr‚es H&=B&*Hsize& ' X&=Min(X&,Ob_x(Popa%(N&),0)+Ob_w(Popa%(N&),0)-W&-2) Y&=Min(Y&,Ob_y(Popa%(N&),0)+Ob_h(Popa%(N&),0)-H&-2) X&=Min(X&,Work_out(0)-W&) Y&=Min(Y&,Work_out(1)-H&) ' Ob_x(Adrpop%,0)=X& Ob_y(Adrpop%,0)=Y& Ob_w(Adrpop%,0)=W& Ob_h(Adrpop%,0)=H& ' For A&=1 To 10 Ob_state(Adrpop%,A&)=Bclr(Ob_state(Adrpop%,A&),0) Ob_state(Adrpop%,A&)=Bclr(Ob_state(Adrpop%,A&),3) Char{Ob_spec(Adrpop%,A&)}="" Ob_w(Adrpop%,A&)=W& Next A& For A&=1 To B& E$=@Xstr_pop$(Pop$(N&),A&) ! physique If Len(E$)>0 E$=Space$(Max(0,2+(C&-Len(E$))\2))+E$ Else Ob_state(Adrpop%,A&)=Bset(Ob_state(Adrpop%,A&),3) E$=String$(C&+4,"-") Endif Char{Ob_spec(Adrpop%,A&)}=E$ Next A& ' ~Objc_draw(Adrpop%,0,7,Ob_x(Popa%(N&),0),Ob_y(Popa%(N&),0),Ob_w(Popa%(N&),0),Ob_h(Popa%(N&),0)) ' ~Graf_mkstate(E&,F&,G&,I&) If G&<>0 ' ~Evnt_button(1,3,0,Mx&,My&,Mk&,A&) C&=0 Else ' ~Evnt_button(1,3,1,Mx&,My&,Mk&,A&) C&=1 Endif D&=-1 Do Mouse Mx&,My&,Mk& If Mx&=>X& And Mx&<=X&+W& A&=(My&-Y&)\Hsize&+1 If A&<0 A&=-1 Endif Else A&=-1 Endif ' If A&<>D& If D&<>-1 Ob_state(Adrpop%,D&)=Bclr(Ob_state(Adrpop%,D&),0) ~Objc_draw(Adrpop%,0,7,Ob_x(Adrpop%,0),Ob_y(Adrpop%,0)+Ob_y(Adrpop%,D&),Ob_w(Adrpop%,D&),Ob_h(Adrpop%,D&)) Endif D&=A& If D&=>1 And D&<=B& If Not Btst(Ob_state(Adrpop%,D&),3) Ob_state(Adrpop%,D&)=Bset(Ob_state(Adrpop%,D&),0) ~Objc_draw(Adrpop%,0,7,Ob_x(Adrpop%,0),Ob_y(Adrpop%,0)+Ob_y(Adrpop%,D&),Ob_w(Adrpop%,D&),Ob_h(Adrpop%,D&)) Else D&=-1 Endif Endif Endif Loop until Mk&=C& If D&<=0 D&=P& Else ' If D&>1 Clr B& For A&=1 To D&-1 If Len(@Xstr_pop$(Pop$(N&),A&))=0 ! Hidden -------- : Physique->Virtuel Inc B& Endif Next A& Sub D&,B& ! en moins (entr‚es hidden) Endif ' Endif ' ~Objc_draw(Popa%(N&),0,7,X&-2,Y&-2,W&+6,H&+6) @Caremouse ' Return D& Endfunc ' ' ' Renvoie le nombre d'entr‚es du popup P$ Function Nmax_pop(P$) $F% Local A&,N& ' N&=1 For A&=1 To Len(P$) If Mid$(P$,A&,1)="|" Inc N& Endif Next A& ' Return N& Endfunc ' ' Renvoie entr‚e popup N [1..maxpop] Function Str_pop$(P$,N&) Local A& A&=Instr(P$,"||") ! ex: Un||Dernier While A&>0 P$=Left$(P$,A&-1)+Mid$(P$,A&+1) A&=Instr(P$,"||") Wend ' Return @Xstr_pop$(P$,N&) ! sans les || Endfunc Function Xstr_pop$(P$,N&) Local A&,B& ' N&=Max(N&,1) A&=0 While N&>1 A&=Instr(P$,"|",A&+1) Dec N& Wend B&=Instr(P$,"|",A&+1) If B&=0 B&=Len(P$)+1 Endif ' Return Mid$(P$,A&+1,B&-A&-1) Endfunc ' ' Renvoie no d'entr‚e de E$ dans P$ [1..] Function No_pop(P$,E$) $F% Local A& ' A&=Instr(P$,"||") ! ex: Un||Dernier While A&>0 P$=Left$(P$,A&-1)+Mid$(P$,A&+1) A&=Instr(P$,"||") Wend ' Return @Xno_pop(P$,E$) Endfunc Function Xno_pop(P$,E$) $F% Local A&,B&,N& ' N&=1 B&=Instr(P$,E$) For A&=1 To B& If Mid$(P$,A&,1)="|" Inc N& Endif Next A& Return N& Endfunc ' ' Renvoie taille max du popup entr‚e P$ Function Len_pop(P$) $F% Local A&,N& ' N&=2 For A&=1 To @Nmax_pop(P$) N&=Max(N&,Len(@Str_pop$(P$,A&))) Next A& ' Return N& Endfunc ' ' Renvoie le num‚ro (index) du popup Adr%,O& Function State_pop(Adr%,O&) $F% Local A& For A&=0 To Npop&-1 If Popa%(A&)=Adr% If Popo&(A&)=O& Return @No_pop(Pop$(A&),Char{Ob_spec(Adr%,O&)}) Endif Endif Next A& Return 1 ! .. Endfunc ' ' S‚lection du nø popup de adr%,o& Procedure Sel_pop(Adr%,O&,N&) $F% Local A& For A&=0 To Npop&-1 If Popa%(A&)=Adr% If Popo&(A&)=O& Char{Ob_spec(Popa%(A&),Popo&(A&))}=@Str_pop$(Pop$(A&),N&) Exit if True Endif Endif Next A& Return ' ' fin popups ' -------------------------------------------------- ' ' ' Ajouts (c)'97 ' ' Envoyer … appli un message Id,MesId,W3,W4,W5,W6 Procedure Xxappl(C0&,C1&,C2&,C3&,C4&,C5&,C6&) Local A& ' ' If Prg_id&=>0 ' ' print "Send message #"+Str$(C1&)+" to "+Str$(C0&)+" with "+Str$(C2&)+", "+Str$(C3&)+", "+Str$(C4&)+", "+Str$(C5&) ' A&=@Wind_update01(-1) ~@Wind_update01(0) ' Msg&(0)=C1& Msg&(1)=Ap& Msg&(2)=0 Msg&(3)=C2& Msg&(4)=C3& Msg&(5)=C4& Msg&(6)=C5& Msg&(7)=C6& Gcontrl(0)=12 ! Appl_write Gcontrl(1)=2 ! G-intin Gcontrl(2)=0 Gcontrl(3)=1 ! G-adrin Gintin(0)=C0& ! Id destinataire Gintin(1)=16 ! Size Addrin(0)=V:Msg&(0) ! Adr Gemsys 12 ! AES ' ~@Wind_update01(A&) ' Endif Return ' ' protocole va_start Procedure Va_bra(E&) Local Adr% Local E$ ' $S& Select Byte(E&) Case &H11 ! VA_START Adr%=Rol(Card(Wmenu&(3)),16)+Card(Wmenu&(4)) ' ' Ack: Gosub Xxappl(Wmenu&(1),&H4738,Wmenu&(3),Wmenu&(4),0,0,0) ' If Adr%>0 E$=Char{Adr%} If @Fexist(E$) Else Menu.info("Fichier "+E$+" introuvable!") Endif Endif Endselect ' Return ' Function Fopen(File$,N&) ! n=0 read,1 write,2 r/w Local E$ E$=File$+Chr$(0) Return Gemdos(61,L:V:E$,N&) Endfunc Function Fcreate(File$,N&) Local E$ E$=File$+Chr$(0) Return Gemdos(60,L:V:E$,N&) Endfunc Deffn Fclose(H&)=Gemdos(62,H&) Deffn Fwrite(H&,E$)=Gemdos(64,H&,L:Len(E$),L:V:E$) Function Fread$(H&,L%) Local E$ E$=Space$(L%) If Gemdos(63,H&,L:L%,L:V:E$)<0 Clr E$ Endif Return E$ Endfunc Function Tsterr(E%) $F% If E%<0 ~@Form_alert(1,@Errf$(E%)) ~@Infow(4,@Errf$(E%)) Return False Endif Return True Endfunc Deffn Fseek(H&,L%)=Gemdos(66,L:L%,H&,0) Deffn Frelseek(H&,L%)=Gemdos(66,L:L%,H&,1) Deffn Fendseek(H&,L%)=Gemdos(66,L:L%,H&,2) Deffn Fadrwrite(H&,Adr%,L%)=Gemdos(64,H&,L:L%,L:Adr%) Deffn Fadrread(H&,Adr%,L%)=Gemdos(63,H&,L:L%,L:Adr%) ' Function Fdelete(File$) $F% File$=File$+Chr$(0) Return Gemdos(65,L:Varptr(File$)) Endfunc ' ' ' Function Jpg2vdt$(File$,X&,Y&,Bit7!,Cut!) Local Len%,Adr%,Adr2%,Len2% Local Fileh& Local A!,B! Local A%,B%,C% Local Tme! Local A$,Tmp$,Ptg$ Local W&,H& Local Err! Local Dta% ' Dta%=Fgetdta() Err!=False Defmouse 2 If Len(File$)>0 If True ' If Fsfirst(File$,0)=0 Len%=Long{Dta%+26} Adr%=Malloc(Len%+3) ! +3=si codage tme If Adr%>0 ' Fileh&=@Fopen(File$,0) If @Tsterr(Fileh&) If True ' ' Read file If @Tsterr(@Fadrread(Fileh&,Adr%,Len%)) ' If True ! cut JPEG If Cut! ! cut JPEG Adr2%=Malloc(Len%+3) ! autre buffer dest (+3=si tme) Endif ' If Adr2%>0 Or (Not Cut!) A!=False ! ne rien copier pour l'instant B!=False Clr A%,B% While Len%-A%>0 Select Rol(Byte{Adr%+A%},8)+Byte{Adr%+A%+1} Case &HFFD8 ! d‚but photo A!=True ! copier Case &HFFDB ! seuils A!=True ! copier Case &HFFC0 ! w,h A!=True ! copier ' C%=A% ' Add A%,2+3 H&=(Rol(Byte{Adr%+A%},8)+Byte{Adr%+A%+1}) Add A%,2 W&=(Rol(Byte{Adr%+A%},8)+Byte{Adr%+A%+1}) ' If Mod(W&,8)<>0 ~Form_alert(1,"[3][La largeur devrait ˆtre |multiple de 8..][Continuer]") Endif ' If W&<=320 And H&<=240 ! ok H&=(H&+9)\10 W&=(W&+7)\8 ' Else ~Form_alert(1,"[3][Fichier trop grand!|Max: 320*240|Fichier: "+Str$(W&)+"*"+Str$(H&)+"][Abandon]") Clr File$ Endif ' A%=C% ' Case &HFFDA ! data compress‚es A!=True ! copier Case &HFFD9 ! fin A!=True ! copier B!=True ! copier et fin Case &HFFC4 ! ???????????????? A!=True ' Case &HFFFE,&HFFEE,&HFFED ! ignorer commentaires, Hufmann & co.. A!=False Endselect If Cut! ! cut JPEG If A! If Not B! Byte{Adr2%+B%}=Byte{Adr%+A%} Inc B% ' Else ! FFD9 Byte{Adr2%+B%}=Byte{Adr%+A%} Inc B% Byte{Adr2%+B%}=Byte{Adr%+A%} Inc B% Exit if True ! sortie Endif Endif Endif Inc A% Wend If Cut! ! cut JPEG Len%=B% ! nouvelle longueur! ' ~Mfree(Adr%) Adr%=Adr2% ! v‚ritable bloc! Endif ' Else ~Form_alert(1,"[3][ProblŠmes de m‚moire!][Abandon]") ~Mfree(Adr%) Adr%=-1 Endif Endif ' If W&*H&=0 ! Probleme! ~Form_alert(1,"[3][ProblŠmes de fichier JPeG|(W ou H == 0)][Abandon]") Err!=True Endif ' Tme!=False If Bit7! ! transform -> 7bits If Adr%>0 Tme!=True ! codage TME Len2%=(Len%*4)\3+3 ! taille max Adr2%=Malloc(Len2%) ! autre buffer dest ' ' Paquets de 3.. If Mod(Len%,3)<>0 Len%=(Len%\3+1)*3 ! on a de tt fa‡on une marge de 3o Endif ' If Adr2%>0 ' A%=0 B%=0 While Len%-A%>0 ' ' Codage 3->4 (mode tme 2) Byte{Adr2%+B%}=Ror(And(Byte{Adr%+A%},&X11000000),2)+Ror(And(Byte{Adr%+A%+1},&X11000000),4)+Ror(And(Byte{Adr%+A%+2},&X11000000),6) Byte{Adr2%+B%+1}=Bset(And(Byte{Adr%+A%},&X111111),6) Byte{Adr2%+B%+2}=Bset(And(Byte{Adr%+A%+1},&X111111),6) Byte{Adr2%+B%+3}=Bset(And(Byte{Adr%+A%+2},&X111111),6) ' Add A%,3 ! 3octets 8 bits Add B%,4 ! ->4 octets "7 bits" Wend ' Len%=B% ! nouvelle taille jpg ~Mfree(Adr%) Adr%=Adr2% ! nouveau fichier jpg ' Else ~Form_alert(1,"[3][ProblŠmes de m‚moire!][Abandon]") ~Mfree(Adr%) Adr%=-1 Endif Endif Endif ' ' ' If Adr%>0 ' ' ' En tˆte: RTD, PPL, PAS le reste r-a-p ' ' RTD A$=Mki$(&H2030)+Chr$(&H45)+Chr$(1)+Chr$(&HFF) ' ' PAS A$=A$+Mki$(&H2133) A$=A$+@Norm$((W&*8)/320) ! sizw A$=A$+@Norm$((H&*10)/320) ! sizh ' ' PPL A$=A$+Mki$(&H2134) A$=A$+Chr$(&H40)+Chr$(1)+Chr$(&H0) ! refh 0 A$=A$+Chr$(&H40)+Chr$(1)+Chr$(&H0) ! refv 0 A$=A$+@Norm$(((X&-1)*8)/320) ! offh A$=A$+@Norm$(((25-Y&)*10)/320) ! offv ' If Tme! A$=A$+Mki$(&H2530) A$=A$+Chr$(&H44)+Chr$(1)+Chr$(2) ! etm 2 Endif ' ' ' ESC p CMI LI data Ptg$=Ptg$+Chr$(27)+"p#@"+@Lil$("Q"+A$) ' ' Fichier JPeG: ' ESC p CMI LI Ptg$=Ptg$+Chr$(27)+"p#@"+@Li$(Len%+1)+"S" ' data If Len%<32000 Tmp$=Space$(Len%) ~Fre(0) Bmove Adr%,V:Tmp$,Len% If Len(Ptg$)+Len(Tmp$)<32000 Ptg$=Ptg$+Tmp$ Clr Tmp$ Endif Endif ' Endif ! adr%>0 ' Endif ' Endif ~@Fclose(Fileh&) Endif ' Else ~Form_alert(1,"[3][Pas assez de m‚moire!][Ok]") Endif Else ~Form_alert(1,"[3][Fichier introuvable!!!][Ok]") Endif Endif Endif Defmouse 0 ' If Not Err! Return Ptg$ Else Return "" Endif Endfunc Function Lil$(A$) Return @Li$(Len(A$))+A$ Endfunc Function Li$(Len%) Local A& Local A$,I$ Local A! ' ' %NNXXXXX Clr A$ I$=Bin$(Len%) A!=True ! dernier octet (premier … ˆtre incrit)=%10 While Len(I$)>5 If A! Clr A! A$=Chr$(Val("%10"+Right$(I$,5)))+A$ ! last one (neme) Else A$=Chr$(Val("%11"+Right$(I$,5)))+A$ ! ke Endif I$=Left$(I$,Len(I$)-5) Wend If A! A$=Chr$(Bset(Val("%"+I$),5))+A$ ! last one (premier et dernier) A!=False Else A$=Chr$(Bset(Bset(Val("%"+I$),5),6))+A$ ! ke aussi (premier) Endif ' Return A$ Endfunc Function Norm$(A#) Local A& Local A$,I$ ' ' 6+7 = pr‚cision > 10^-3 Clr A$ For A&=0 To 12 If A#=>2^(-A&) I$=I$+"1" A#=A#-2^(-A&) Else I$=I$+"0" Endif Next A& ' A$=Chr$(&H42) ! norm A$=A$+Chr$(2) ! len ' %0XXXXX A$=A$+Chr$(Val("%"+Left$(I$,6))) A$=A$+Chr$(Val("%"+Right$(I$,7))) ' Return A$ Endfunc ' Deffn Pas$(W&,H&)=Mki$(&H2133)+@Norm$((W&*8)/320)+@Norm$((H&*10)/320) Deffn Ppl$(X&,Y&)=Mki$(&H2134)+Chr$(&H40)+Chr$(1)+Chr$(&H0)+Chr$(&H40)+Chr$(1)+Chr$(&H0)+@Norm$(((X&-1)*8)/320)+@Norm$(((25-Y&)*10)/320) Deffn Lid$(A$)=Chr$(27)+"p#@"+@Lil$("Q"+A$) Deffn Lij$(Len%)=Chr$(27)+"p#@"+@Li$(Len%+1)+"S" ' ' ' ' ' ' ' ' ' ' ' ' ** End ** ' ' ' -------------------------------------------------- ' Datas: ' -------------------------------------------------- Instr: ' ' Nom_instruction, abrev1, abrev2, abrev3, param1, param2, param3 ' paramx: 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc ' ' ' * 1er p: 0: f graph ' 1: commande: ' 2: display/etc ' 3: var ' 4: ifs/conds ' 5: boucles ' 6: char de controle ' ' * Puis Instruction l‚gales, et ses 3 abrevs ' ' * 10 ParamŠtres: ' 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc ' ' Data 0,TXT,AFF,PRINT,?,4,-2 Data 0,OUT,CHR,SEND,SE,2,-2 ' ' paramx: 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc ' SET A,10 Data 3,SET,LET,EQU,S,5,3,-2 ' SSET A,ÝEXEMPLEÝ Data 3,SSET,LETS,EQUS,SETS,6,4,-2 Data 3,CLR,ERASE,CLRV,C,5,-2 Data 3,CLRS,CLEARS,DELS,EMPTS,6,-2 ' Data 3,SETPAR,STP,SP,SETPR,2,3,-2 Data 3,SSETPAR,SETSP,SSP,SETPS,2,4,-2 ' Data 3,SETVAR,STV,SV,SETVR,2,3,-2 Data 3,SSETVAR,SSETVR,SSV,SETSVAR,2,4,-2 ' ' FOR A,1,10 : FOR A=1 TO 10 Data 5,FOR,FR,F,FRO,5,3,3,-2 ' FORS A,1,10,2 : FOR A=1 TO 10 STEP 2 Data 5,FORS,FOS,FOP,FOSR,5,3,3,3,-2 Data 5,NEXT,NX,NXT,NTX,-2 Data 5,DO,D,BOUCLE,BOU,3,-2 Data 5,REPEAT,REP,RPE,RPT,-2 Data 5,UNTIL,UNTL,UNT,LOOPUNTIL,3,-2 Data 1,REDO:,REDO,RDO,REMAKE,3,-2 ' Data 5,PROCEDURE,PRC,PROCD,PROCEDR,9,-2 Data 5,RETURN,RT,RTR,ENDPROC,-2 ' Data 3,ADDS,ADS,AS,AJOUTEC,6,4,-2 Data 3,GETCHAR,CHAR,GC,GE,6,3,4,-2 Data 3,GETSTR,MID$,GS,COPY,6,3,3,4,-2 Data 3,UPPERS,UPERS,UPPS,UPPER,6,-2 Data 3,TRIMS,TRM,TRMS,TRONQUE,6,-2 Data 3,GETLEN,GTL,GL,GETLENGTH,2,4,-2 Data 3,ASC,BYTE,GA,GETASC,5,3,4,-2 Data 3,ASCW,WORD,GAW,GETASCW,5,3,4,-2 Data 3,ASCL,LONG,GAL,GETASCL,5,3,4,-2 ' Data 3,ADD,AJOUTE,+,DA,5,3,-2 Data 3,SUB,SOUSTRAIT,-,USB,5,3,-2 Data 3,MUL,MULTIPLIE,*,ULM,5,3,-2 Data 3,DIV,DIVISE,DV,/,5,3,-2 Data 3,MOD,MODULO,MD,MDO,5,3,-2 Data 3,AND,&,ET,ANDI,5,3,-2 Data 3,OR,|,OU,ORI,5,3,-2 Data 3,XOR,X,|!,ORX,5,3,-2 Data 3,NOT,!!,NON,NT,5,-2 Data 3,INC,++,INCR,INCRM,5,-2 Data 3,DEC,--,DECR,DECRM,5,-2 ' Data 3,BSET,BST,SETB,BITSET,5,2,-2 Data 3,BCLR,BCL,CLRB,BITCLEAR,5,2,-2 Data 3,BCHG,BG,CHGB,BITCHANGE,5,2,-2 Data 3,BTST,BTS,TSTB,BITTEST,5,3,2,-2 ' Data 3,ROR,ASR,LSR,SR,5,3,-2 Data 3,ROL,ASL,LSL,SL,5,3,-2 ' ' paramx: 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc ' Data 2,DISPLAY,VIEW,DIS,INF,4,-2 Data 2,QDISPLAY,QVIEW,QDIS,QINF,4,-2 Data 2,SHOW,PROMPT,SEE,MESSAGE,4,-2 Data 2,ASKEY,AK,AS,ASKKEY,5,-2 Data 2,QASKEY,QAK,QAS,QASKKEY,5,-2 Data 2,INFO,INF,INFOS,IN,1,-2 Data 2,INPUT,INP,INPU,IN,5,-2 Data 2,INPSTR,STRINPUT,INPUTS,STRINP,6,-2 ' ' Data 2,OPT,OPTION,OPTN,OPTI,1,-2 ' Data 0,CLS,CLRSCR,FF,EFF,-2 Data 0,CLL,CLRL0,CLH,EFFL,-2 Data 0,FILL,BOURRAGE,CA,BL,-2 Data 0,CR,CR/LF,CRLF,CRETURN,-2 Data 0,CR2,LF/CR,LFCR,LCR,-2 Data 0,CRH,HAUTC,HAUTCR,CRHAUT,-2 Data 0,CRT,CHR(13),CHR13,CRETURN,-2 Data 0,HOME,TOP,HM,TO,-2 Data 0,TEXTE,SI,TXTE,TEX,-2 Data 0,GRAPHIQUE,GRF,GR,SO,-2 Data 0,RESET,RST,REST,RSET,-2 ' ' paramx: 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc ' Data 0,MAJ,MJ,MAJUSCULE,CAPSLOCK,-2 Data 0,MIN,MINUSCULE,CAPSOFF,MN,-2 Data 0,40COL,40C,40,40COLONNES,-2 Data 0,F80COL,80C,80,80COL,-2 Data 0,A80COL,80CA,80A,80COLONNES,-2 Data 0,KEY,KY,SPECK,SPK,1,-2 Data 0,ROULEAU,ROL,RL,RLEAU,1,-2 ' PROCHAINE INSTR TRANSPARENTE Data 1,TRANSP:,TRN,TRNSP,TRANSPARENCE,-2 Data 0,FORGET,TRINSTR,FRG,OUBLIER,2,-2 Data 0,TRDATA,TRD,DATATR,TRDTA,8,-2 Data 0,DRCTXT,DRCSTXT,DRCS,DRT,1,-2 Data 0,DRCGRF,DRCSGRF,DRCSF,DRG,1,-2 Data 0,TLDRCS,DRSTART,LOADDRCS,DRCSLOAD,-2 Data 0,GLDRCS,DRGSTART,LOADGDRCS,DRCGLOAD,-2 Data 0,ENDTEL,TELEND,DRCSEND,STOPDRCS,-2 Data 1,DRSET:,DRFIRST:,DR=:,FIRSTDR:,4,-2 ' Data 1,STBLOCK,STB,ST,STARTBLOCK,-2 Data 1,STOREBLOCK,STOB,STOBLK,SETBLOCK,6,-2 Data 1,OPTBLOCK,OPTB,OPTBLOK,OPTIMISEBLOCK,6,-2 Data 1,OPTBIN,OPTBN,OPTBINAIRE,OPTIMISE,-2 ' Data 0,ENCRE,ECRITURE,ECR,E,7,-2 Data 0,FOND,BACKGROUND,BACK,F,7,-2 ' Data 0,CURSEUR,CRS,CRSE,CURSOR,1,-2 Data 0,FLASH,CLIGNOTEMENT,LIGHT,CLIG,1,-2 Data 0,MASQUE,MSK,MASK,MASQUER,1,-2 Data 0,CACHER,ETEINT,HID,HIDE,-2 Data 0,MONTRER,ALLUME,MN,UNHIDE,-2 Data 0,LINE,LIGNAGE,LIGNE,LIG,1,-2 Data 0,INVERSE,VIDEO,INVR,INVERT,1,-2 ' Data 0,TAILLE.NORMALE,TN,T.N,NORMAL,-2 Data 0,D.HAUTEUR,DH,DOUBLE.HAUTEUR,HAUTEUR.DOUBLE,-2 Data 0,D.LARGEUR,DL,DOUBLE.LARGEUR,LARGEUR.DOUBLE,-2 Data 0,D.TAILLE,DT,DOUBLE.TAILLE,TAILLE.DOUBLE,-2 ' ' paramx: 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc ' Data 0,HAUT,VT,CURS.H,CH,-2 Data 0,BAS,LF,CURS.B,CB,-2 Data 0,GAUCHE,BS,CURS.G,CG,-2 Data 0,DROITE,HT,CURS.D,DROIT,-2 ' Data 0,REPLIQUE,REP,RP,REPETE,8,-2 Data 0,POS,PS,LOC,LOCATE,2,2,-2 ' ' com var-string Data 4,IFS,IS,IFEQS,IFSTR,4,4,-2 Data 4,IFNES,IFNS,IFNEQS,IFNSTR,4,4,-2 ' Data 4,IF,SI,I,IFF,3,-2 ' if = Data 4,IFEQ,IFE,SIE,IFEQU,3,3,-2 ' Data 4,IFEQS,IFS,SIC,IFEQUS,4,4,-2 ' if <> Data 4,IFNE,IFNOT,SIN,IFN,3,3,-2 ' Data 4,IFNES,IFNOTS,SINS,IFNS,4,4,-2 ' if > STRING: LENGTH Data 4,IFHI,IFGT,SI>,IF>,3,3,-2 ' Data 4,IFHIS,IFGTS,SIS>,IFS>,4,4,-2 ' if => Data 4,IFHS,IFGE,SI>=,IF>=,3,3,-2 ' Data 4,IFHSS,IFGES,SIS>=,IFS>=,4,4,-2 ' if < Data 4,IFLO,IFLT,SI<,IF<,3,3,-2 ' Data 4,IFLOS,IFLTS,SIS<,IFS<,4,4,-2 ' if <= Data 4,IFLS,IFLE,SI<=,IF<=,3,3,-2 ' Data 4,IFLSS,IFLES,SIS<=,IFS<=,4,4,-2 ' Data 4,ENDIF,ENDIF,ENDI,FINSI,-2 Data 4,ELSE,ELS,EL,SINON,-2 ' Data 4,END,STOP,EDIT,HALT,-2 Data 2,FAIL,ERROR,BREAK,ERR,4,-2 ' Data 0,INCBIN,INCBN,LOAD,LO,4,-2 Data 2,elSAVEBIN,SAVEBN,SAVBN,SVB,4,-2 Data 2,CLEARBIN,CLRB,CLEARBN,DELB,-2 Data 2,ADDBIN,ADDB,UPDATE,AJOUTE,4,-2 Data 2,ADDBLOCK,ADDBLK,UPDATEBLK,AJOUTEBLK,4,4,-2 ' Data 0,PHOTO,INCJPG,JPEG,JPG,4,2,2,1,1,-2 Data 0,FCREATE,CREATE,NEWFILE,FILECREATE,4,-2 Data 0,FDELETE,KILL,DELETE,FILEDELETE,4,-2 ' Data 2,',!,;,#,-2 ' Data 2,{,{{{{,#,#,-2 Data 2,},}}}},#,#,-2 Data 2,\,\\\\,#,#,-2 ' ' paramx: 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc ' Data 1,MASKNEXT,MASKN,MASKNE,MN,2,-2 Data 1,EVERY,EVRY,EVR,EVE,2,4,-2 Data 1,EVSTOP,EVERYSTOP,ES,EVRYSTOP,-2 ' Data 0,STRING,STRN,STRNG,STRN,3,4,-2 Data 0,PAUSE,WAIT,DELAY,DELA,3,-2 ' Data 6,PRO1,P1,PR1,PRO.1,-2 Data 6,PRO2,P2,PR2,PRO.2,-2 Data 6,PRO3,P3,PR3,PRO.3,-2 ' Data 0,SPACE,SPC,SP,ESPACE,-2 ' Data 6,SEP,SE,FSEP,SPE,-2 Data 6,ESC,ESCAPE,ESCAP,ECS,-2 Data 6,NULL,CHR(0),NUL,NU,-2 Data 6,SOH,SOH,CHR(1),CTRL(A),-2 Data 6,STX,XST,CHR(2),CTRL(B),-2 Data 6,ETX,XET,CHR(3),CTRL(C),-2 Data 6,EOT,EO,CHR(4),CTRL(D),-2 Data 6,ENQ,EN,CHR(5),CTRL(E),-2 Data 6,ACK,AK,CHR(6),CTRL(F),-2 Data 6,BEEP,BIP,BELL,CTRL(G),-2 Data 6,DLE,DL,CHR(16),CTRL(P),-2 Data 6,NAK,NACK,CHR(21),CTRL(U),-2 Data 6,SYN,SY,CHR(22),CTRL(V),-2 Data 6,ETB,ETB,CHR(23),CTRL(W),-2 Data 6,EM,EM,CHR(25),CTRL(Y),-2 Data 6,CSUB,SB,CHR(26),CTRL(Z),-2 Data 6,FS,FS,CHR(28),CTRL(\),-2 Data 6,GS,GS,CHR(29),CTRL(]),-2 ' Data 6,ESC[,CSI,CSI,SCI,4,-2 ' ' FIN = SWEE Data 1,SWEEETEL,STS,.,.,1,-2 ' ' {= Indent + }=Indent - Data 1,{,INDENT+,[,(,-2 Data 1,},INDENT-,],),-2 Data 1,\,STOPINDENT,/,/,-2 ' ' ' ABREVS.. ' Data 0,BEEP,BIIP,BEL,CTRL-G,-2 ' Data 0,TXT,PRINTF,PR,TEXT,4,-2 Data 0,TXT,AF,ECRIS,AFFICHER,4,-2 Data 0,CURSEUR ON,CHR(17),DC1,CTRL(W),-2 Data 0,CURSEUR OFF,CHR(20),DC4,CTRL(T),-2 Data 0,TAILLE.NORMALE,NORMAL,NORMALE,NORM,-2 Data 0,DOUBLE.TAILLE,TAILLE,TAILL,TAIL,-2 Data 0,DOUBLE.LARGEUR,LARGEUR,LARG,LAR,-2 Data 0,DOUBLE.HAUTEUR,HAUTEUR,HAUTE,HAUTEU,-2 Data 5,NEXT,FIN,LOOP,WEND,-2 Data 0,ENCRE,EN,ENCR,ENC,7,-2 Data 0,ENCRE,COLOR,COLO,COL,7,-2 Data 0,ENCRE,COUL,COULEUR,COU,7,-2 Data 0,FOND,FON,BACKG,FN,7,-2 Data 0,FOND,DEFFILL,DEFFIL,DEFF,7,-2 Data 0,CURSEUR,CUR,CURSEU,CRS,1,-2 Data 0,FLASH,FLA,CLI,FLAS,1,-2 Data 0,CACHER,CACHE,CAC,HIDDEN,-2 Data 0,MONTRER,MONT,MONTR,MONTRE,-2 Data 0,INVERSE,INVE,INVERT,I,1,-2 Data 0,POS,SETPOS,SEPOS,STPOS,2,2,-2 Data 0,GRAPHIQUE,GRA,GRAP,G,-2 Data 0,LINE,LIGN,L,LIN,1,-2 Data 0,ROULEAU,RO,R,RL,1,-2 Data 0,LINE,SOULIGNE,SOULIGN,SOULIGNEMENT,1,-2 Data 5,PROCEDURE,PROCDURE,PROC,PROCEDU,9,-2 Data 0,MAJ,MAJUSCULE,MAJUSCULES,MAJU,-2 Data 0,INVERSE,INVERS,INVERSER,INV,1,-2 Data 0,MASQUE,MASQU,MASQUER,MASQ,1,-2 Data 0,POS,POSITION,POSIT,GOTOXY,2,2,-2 Data 0,ENCRE,P,ENCR,P,7,-2 Data 0,REPLIQUE,REPL,RPL,REPLI,8,-2 Data 0,TXT,A,AT,ATXT,4,-2 ' ' Data 5,@,GOSUB,GO,JMP,4,-2 ' Data 0,HAUT,H,HA,HAU,-2 Data 0,BAS,B,BA,DOWN,-2 Data 0,GAUCHE,GA,GAUC,GAUCH,-2 Data 0,DROITE,DR,DRO,DROI,-2 Data 0,CR,CRLF,CRL,CR/LF,-2 ' ' ' Data 1,GAG,00,00,00,1,-2 ' ' Data 1,IS.NOT.TOS,UNIX,00,00,00,-2 Data 1,READ.THE.DOC!,HELP,00,00,-2 ' Data 255,,,,,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1 ' ' paramx: 0= AUCUN, 1=ON/OFF, 2=OCTET, 3=INT, 4=STRING, 5=VAR, 6=VAR$, 7=COULEUR 8=1..63 9=nom proc ' ' ' ' Instrh: fichier SWEETEL2.INA ' ### | | | | | | | | ' ' ' ' ' ' -------------------------------------------------- Data " " Data "Sweetel ('Editex' 1.0 ,1992) " Data " Version 2 " Data Data " " Data "Sweetel¿ Oct-Avril/Juillet/Ao–t/Fev/Juin 1992/93/94/95 ¾,½'X.Roche/Sts" Data "Programme: GfA 3 - Optimis‚ en assembleur 68000 et en C" Data "Version compatible ST/STE/TT/Falcon 030/etc.." Data "Programme GEM-TOS/MultiTOS" Data "Droits d'auteur r‚serv‚s … Xavier Roche" Data Data [End Of List] ' Data << Vive Atari! >> Data " " Data " " ' -------------------------------------------------- ' ' *** Fini! (SWT) *** ' '