' ' ' ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Sweetel¿ (Version 2) ' Swiftel (Version 3) ' Emulateur de terminal ' * ' ½97 ' ALL RIGHTS RESERVED ' Tous droits r‚serv‚s … l'auteur ' * ' Interface: WindTool¿ ½RX ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' ' ' ' [Divisions entiŠres, RC 4 octets, select 4 octets, fonction: int] ' $m150000 ' $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 Cache%,86 Inline Swchar%,104 ' Inline Find0%,50 ' Inline Clrblk%,140 Inline Qcopy%,172 ' Inline Dta%,128 ' ' ' ///////////////////// ' Charger routines: ' My_load ' Edit ' \\\\\\\\\\\\\\\\\\\\\ ' Option Base 0 Defwrd "A-Z" Deflist 3 ' Startex: ! Pour Resume Void Cvl("½'98") Void Cvl("R.X.") Void &H12345678 ' (repŠre) ' Gosub Main ' ' $P< Procedure Main Void Gemdos(&H1A,L:Dta%) ! PLACER DTA - ATTENTION! SINON PROB EN ACC! Drive&=Gemdos(25) ! drive init Nbrcol&=Work_out(13) ' Vopen!=False ! fichier "#5" (direct gemdos) ferm‚ pour l'instant Let Name$="Swiftel photo" Let Release$="3.70" Let Release&=&H370 Title$=Chr$(32)+Name$ Atitle$=" "+Name$ ' Wd_set!=True ! formulaires dans des fenˆtres ' Set_system&=0 ! gestion normale Set_end!=False ! ne pas stopper le programme huhu!! Set_escape!=False ! ne pas quitter sans effacer les champs! ' 'Set_mouse&=-1 ! defmouse non install‚ Set_critical!=False ! Etat non critique (m‚moire pleine) Set_progress!=True ! barre de % ' Linea!=True ! Pr‚sente … priori Linea!=False ! NAN Set_send!=False ! On envoie pas yet Set_wdial!=False ! pas en mode dialogue Shootme&=0 ! pas de RESET intemp‚stifs svp!! ' ' -------------------- On error gosub Werror ' -------------------- ' ' A modifier ‚vent. (cf aprŠs, princ2) Inibin%=80000 Inipho%=34000 ' ' Mem%=100000 ! K (fictif) ' Limit%=10000 ! Nb d' octs critiques.. ' Lowlimit%=6000 ! Nb d' octs critiques en dessous desquels on ne peut plus Binsz%=Inibin% Ph_siz%=Inipho% ' rien faire! ' actb&=0 ! Bloc 0 par d‚faut ' Minbin&=1024 ! m‚m bloc minimal ' ' pr‚d‚finitions ' slow!=False Ascii&=0 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... Vcr!=False ! emul curs flag Log!=True ! log file ' Recept!=True ! ‚mulation Emul!=True Answer!=True Ansid|=4 ! photo Devh&=-1 ' Nice!=True ! nice window ' Afdrc!=True Emx&=4 ! pos ‚mulateur dans la fenˆtre Emy&=4 ' Termf|=0 ! couleursterminal d'initialisation Termt|=7 ' ' Objets desktop ' Desk_c!=True Desk_m!=False Desk_f!=True Desk_i!=True ' ' Dimensions terminal Xterm&=80 Yterm&=25 ' Ttxt&=12 ! taille texte graph Col1&=1 Colg&=2 Font&=1 ! Fonte texte ' Dwn$="XYZ.TTP" Upl$="XYZ.TTP" Dwnpar$="-rz" Uplpar$="-sz $" ' 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 ' ' D‚finir chemin Set_path$=Space$(2048) Void Fre(0) Void Gemdos(71,L:V:Set_path$,Drive&+1) Set_path$=Chr$(65+Drive&)+":"+Left$(Set_path$,Instr(Set_path$,Chr$(0))-1)+"\" ' ' If Not Dim?(Key$()) Dim Falskey$(3),Key$(3) Endif ' ' open "O",#5,"AUX:" ! flux sortie RS232 AVANT ' Gosub Get_rs aprŠs, avec rsrc_load ' @Rsio ! direct gemdos ' ' Gosub Ld.cnf Emx&=4 Emy&=4 Emy2&=0 Gosub Reng ' ' -------------------- ' ..8 fenˆtres. ' Nombre_w&=9 Nombre_w&=7 ' Wdial&=7 ! id fenetre dial Wdial&=5 ! id fenetre dial Wd_id&=1 ! id dialogue Wd_set!=True ' -------------------- ' Gosub Start ' -------------------- Return $P> ' ' ' -Princ- pour accessoire et programme $P< Procedure Acc_princ ! init ' Gosub Deftext(Col1&,0) If Gdos? Set_font(Font&) Get_csize Endif Dims&=Max(200,Min(Dims&,Fre(0)\40)) Gosub Inistr ! looong init ' Wset_max_h(3,(Toti&+4)*Ccsizey&) ! nb max d'instr ' ..et fenˆtres! ' Bndary(0) Gosub Deffillcol(0) ' Set_system&=0 ! systŠme ok ' Gosub Deffillcol(Colg&) Gosub Deffillcol(Colg&) Gosub Defmouse(0) ' Set_end!=False ! Boucler ' If Caches%>0 ! BUG REPORT! peut ne servir … rien (..) @Cache_uninit Endif ' ' ' Return Procedure Acc_princ2 ! do Local Boucl&,Evnmnt&,A& ' ' print "PRINC2" Gosub Tstrg If (Len(Register$)=0) If Accessoire!=False Gosub Qinfo Endif Endif ' Set_system&=0 ~@Wind_update01(1) ! wind update ' print "OPENLOG" Gosub Openlog ' print "FINOPEN" Outlog("*Le "+Date$) Recept!=True ! ‚mulation Emul!=True ' If Malloc(-1)<150000 ! pas bcp de m‚moire.. Inibin%=2048 ! limiter alors! Inipho%=16000 Endif ' ' Buffer vid‚otex Binlen%=Inibin% ! Taille ' ' P1__&=Byte(Ror(Xbios(15,-1,-1,-1,-1,-1,-1),24)) ! paramŠtres de la RS232C ' print "INITS" Gosub Io_init ' print "FINIO" ' ' ' INITs ‚mulation Gosub Emul_init ' print "FINEMUL" Gosub Drcs_init ' print "FIN INITS" ' ' Gosub Iofile(True) ! remplace Open #5 ~@Tstblk ' ' '' open "O",#5,"AUX:" ! flux sortie RS232 ' @Videmntl ' Vopen!=True ' Gosub Setspeed ' If Set_speed! ' Outvid(V1200b$) ' Else ' Atsend(Modem$(0)) ! init ' Endif ' If Caches%<=0 ! plus de cache!! Gosub Cache_init Endif ' print "FIN CACHE" ~@Winds_fields ! Recr‚‚er champs! ' print "FIN FIELD" ' If Eccldx&*Eccldy&<>0 ' Gosub Nice_size((Vmax_x&+1)*Eccldx&,(Vmax_y&+1)*Eccldy&) ' Else ' Nice_size pour l'‚mulateur ' If Nice! If Setew&*Seteh&=0 Gosub Nice_size(W_ew&(4),W_eh&(4)) Else If Nice! Gosub Nice_size(Min(W_desk&,Setew&),Min(H_desk&,Seteh&)) Else Gosub Nice_size(Setew&,Seteh&) Endif Endif ' Endif ' Endif Gosub Nice4 ' ' print "FIN NICE" ' ' @Videkbd Gosub Defmouse(2) If Emulm|<>0 Gosub Emulm(0) Endif Ncurs!=True ' ~@Wind_update01(0) ! wind update ' ' Set_system&=2 If Prg_id&<0 ! normal If Accessoire! ' ~@Wind_open(Nombre_w&-1) Gosub Menu_dsk ~@Wind_create(1) ~@Wind_create(4) If Whandle&(1)=>0 If Whandle&(1)=Whandle&(4) ! ahrgh! ~@Wind_delete(1) ~@Wind_delete(4) @W_rdexe ~@Wind_create(1) ~@Wind_create(4) If Whandle&(1)=Whandle&(4) ! ahrgh! ~@Wind_delete(4) ~@Wind_open(1) @W_rdexe ~@Form_error(1,"[1][SwifteL!|Erreur fenˆtre non ouvrable!][Annuler]") Else ~@Wind_open(1) @W_rdexe ~@Wind_open(4) Endif Else ~@Wind_open(1) @W_rdexe ~@Wind_open(4) Endif Else ~@Wind_open(1) @W_rdexe ~@Wind_open(4) Endif Else If Len(Register$)=0 ~Form_dial(3,0,0,0,0,Rx&(2),Ry&(2),Rw&(2),Rh&(2)) Endif ~@Wind_open(4) Endif ' Else Gosub Xxopen ! open pour l'autre application Endif ' Gosub Set_col(True) ' Gosub Defmouse(0) @Showm Set_end!=False ! Boucler Prg_lock!=False Gosub Infpay(0) Gosub W_rdexe If Prg_id&<0 ! normal If Len(Hello$)>0 Esend(@Cstr$(Hello$)) Endif Endif ' ' ' V‚rifier si premiŠre utilisation! Gosub First_use ' ' Init modem Gosub Mod_init(False) ' Gosub W_rdexe ' ' Auto macro If Prg_id&<0 ! normal If @Exist(Set_path$+"SYSTEME\MACROS\"+"START"+".SPM") ! load ~@Macload(Set_path$+"SYSTEME\MACROS\"+"START"+".SPM") ! load Gosub Macexe ! EXEC Endif Endif Gosub Parm_test ' If Len(Register$)>0 Menu.info("-== Enregistr‚ …: "+Key$(0)+" ==-") Endif Gosub Outcom("") ! v‚rifier datation ' ' ' ..Boucle principale Do If Not Prg_lock! If Lastsend|=0 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)),250,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)),100,Mx%,My%,Mk&,Dummy&,Key&,Clic&) Endif Else If Lastsend|=0 Evnmnt&=Evnt_multi(&X110000,$ And And And And Eqv *+3,3,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),250,Mx%,My%,Mk&,Dummy&,Key&,Clic&) Else Dec Lastsend| Evnmnt&=Evnt_multi(&X110000,256+3,3,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),100,Mx%,My%,Mk&,Dummy&,Key&,Clic&) Endif Endif Shift&=@Bios11 ' Ha&=@Firstw ' If (Not Wopen!(4)) If Accessoire! Or Fastquit! If Whandle&(0)=>0 ~@Wind_delete(0) Endif If Whandle&(4)=>0 ~@Wind_delete(4) Endif Set_end!=True Endif Endif ' ' Y a -t- il eu un evnt-mesag? (a traiter en 1er) If Btst(Evnmnt&,4) ! Evnt Menu AES ' ' menu.info(" Message="+Str$(Wmenu&(0))) ' ' 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&,Shift&) Endif ' ' ' Exit if Set_end! Loop until Set_end! ' ' Si en mode programme, le fait de quitter implique qu'on n'a pas besoin ' d'effacer tous les champs! If Not Accessoire! Set_escape!=True ! Quitter physiquement (pas besoin de Clear() ) Endif ' If Wopen!(4) ! toujours ouverte? ' Auto macro If @Exist(Set_path$+"SYSTEME\MACROS\"+"END"+".SPM") ! load ~@Macload(Set_path$+"SYSTEME\MACROS\"+"END"+".SPM") ! load Gosub Macexe ! EXEC Gosub W_rdexe Endif Endif ' Gosub Defmouse(2) Gosub Set_col(False) ' Gosub Rq_time(True) ! effacer msg? ' ' ..Fermer tout ce qui reste Set_system&=2 ! No Redraw! For Boucl&=0 To Nbr_idxw& ~@Wind_close(Boucl&) Gosub W_rdexe Next Boucl& ' Set_system&=0 ' If Vopen! If Set_speed! If Speed&<>0 Gosub Defmouse(2) @1200b Gosub Defmouse(2) Endif Send(Cls$+Curson$) Gosub Defmouse(2) Else If Not Accessoire! If Connect! Atsend(Modem$(3)) ! ath Connect!=False Endif Atsend(Modem$(1)) ! end Gosub Xconnect Else If Connect! If @Form_alert(1,"[2][D‚connexion modem?][Confirmer|Annuler]")=1 Atsend(Modem$(3)) ! end Connect!=False Endif Endif Atsend(Modem$(1)) ! end Endif Endif Endif ' Gosub Cache_uninit ' Gosub Io_uninit ' If Prg_id&=>0 ! command‚ Gosub Xxappl(Prg_id&,&H1029,0,0,0,0,0) ! closed! Endif ' ' If Not Accessoire! ' ~Form_dial(3,0,0,0,0,Rx&(2),Ry&(2),Rw&(2),Rh&(2)) ' Endif Gosub Defmouse(0) ' ~@Mfree(Binair%) ' Outlog("**Fermeture de "+Name$) Gosub Closelog Gosub Infpay(True) Return $P> ' Procedure Io_init P1__&=Byte(Ror(Xbios(15,-1,-1,-1,-1,-1,-1),24)) ! paramŠtres de la RS232C Gosub Iofile(True) ! remplace Open #5 ' @Videmntl Vopen!=True Gosub Setspeed Return Procedure Io_uninit ' @Videmntl ' '' close #5 Gosub Iofile(False) ! remplace Close #5 Vopen!=False ~Xbios(15,-1,-1,P1__&,-1,-1,-1) Return ' ' PremiŠre utilisation? Procedure First_use Local Fileh& Local A&,N&,P&,R& Local E$ ' If Not @Exist(Set_path$+"SYSTEME\HISTORY.SYS") ! premiŠre utilisation! If Left$(Set_path$,1)="A" Or Left$(Set_path$,1)="B" If @Form_alert(1,"[3][Vous devriez installer|Swiftel sur disque dur][J'y vais| Non ]")=1 Set_end!=True Endif Endif ' If Not Set_end! ! on continue ' Clr E$ ' | | E$=E$+"Vous lancez Swiftel photo pour|" E$=E$+"la premiŠre fois.. |" E$=E$+" |" E$=E$+"Swiftel n'a pas encore ‚t‚ |" E$=E$+"configur‚ ; pour cela, vous |" E$=E$+"devez indiquer le type de |" E$=E$+"p‚riph‚rique raccord‚ … votre |" E$=E$+"ordinateur (modem ou minitel) |" E$=E$+"et presser sur 'Configurer' |" E$=E$+"Swiftel recherchera alors le |" E$=E$+"port s‚rie libre et le confi- |" E$=E$+"-gurera automatiquement. |" E$=E$+" |" E$=E$+"En cas de problŠmes (pas de |" E$=E$+"(r‚ponse, modem qui renvoi des|" E$=E$+"signes non lisibles ou |" E$=E$+"parazit‚s) essayez de r‚gler |" E$=E$+"l'interface s‚rie (modem) par |" E$=E$+"le panneau de contr“le (dans |" E$=E$+"les accessoires: XCONTROL) et |" E$=E$+"recommencez (initialiser le |" E$=E$+"modem, dans le menu) |" E$=E$+" |" E$=E$+"Si vous rencontrez d'autres |" E$=E$+"difficult‚s ou des problŠmes |" E$=E$+"lors de l'utilisation de ce |" E$=E$+"programme, n'h‚sitez pas … |" E$=E$+"consulter la documentation de |" E$=E$+"Swiftel photo et notamment son|" E$=E$+"index, ainsi que les questions|" E$=E$+"/r‚ponses aux problŠmes les |" E$=E$+"plus courants! (Ceci peut ˆtre|" E$=E$+"fait depuis Swiftel photo, |" E$=E$+"avec l'option 'Charger autre')|" E$=E$+" |" E$=E$+"Nous vous remercions encore |" E$=E$+"pour votre soutient apport‚ … |" E$=E$+"ce programme. |" E$=E$+" |" E$=E$+" |" E$=E$+" |" E$=E$+"Credits: |" E$=E$+"ÿÿÿÿÿÿÿ |" E$=E$+" Programmation&Documentation: |" E$=E$+" Xavier Roche|" E$=E$+" |" E$=E$+" Passerelle IP: |" E$=E$+" Yannick Lecaillez|" E$=E$+" Modules externes: |" E$=E$+" M&E ½PARX|" E$=E$+" Eric Da-Cunha|" E$=E$+" |" E$=E$+" Soutient du projet: |" E$=E$+" Thierry Benet|" E$=E$+" D‚pt. documentation SEPT Caen|" E$=E$+" Les 'points' de THEBBS|" E$=E$+" ...ainsi que les nombreux |" E$=E$+" utilisateurs qui ont soutenus|" E$=E$+" et continuent de soutenir ce |" E$=E$+" programme! |" E$=E$+" |" E$=E$+" ½1998 Xavier Roche|" E$=E$+" |" ' Clr N& Exdo!=True A&=Byte(@Form_wdo(38,-2)) Do Clr P& If N&>0 For A&=0 To N& P&=Instr(E$,"|",P&+1) Next A& Endif For A&=0 To 7 Char{Ob_spec(Adr%(38),Cf_1st&+A&)}="" Next A& For A&=0 To 7 R&=P& P&=Instr(E$,"|",P&+1) Exit if P&<=0 Char{Ob_spec(Adr%(38),Cf_1st&+A&)}=Left$(Mid$(E$,R&+1,P&-R&-1),30) Next A& ' ~Objc_draw(Adr%(38),Cf_1st&-1,7,Rx&(38),Ry&(38),Rw&(38),Rh&(38)) A&=Byte(@Form_wdo(38,0)) Ob_state(Adr%(38),A&)=Bclr(Ob_state(Adr%(38),A&),0) Select A& Case Cf_up& N&=Max(0,N&-1) Case Cf_dw& N&=Min(60,N&+1) Default Exit if True Endselect Loop ~@Form_wdo(38,-3) If A&=Cf_ok& If Btst(Ob_state(Adr%(38),Cf_1&),0) ! modem ' Select @Form_alert(1,"[2][Utilisez-vous un modem |USRobotics? (Sportser Voice)|Si r‚ponse inconnue: Inconnu ][Non|Oui|Inconnu]") Case 1 Case 2 Let Modem$(0)="ATZ\r~ATS27.4=1\r" Case 3 ~Form_alert(1,"[3][Si vous poss‚dez un modem |USRobotics, veuillez lire le |fichier USROBOTI.CS dans |SWIFTELP\DOCUMENT\][Not‚!]") Endselect ' Speed&=4 Set_speed!=False Answer!=True @Setspeed Gosub Mod_init(True) ! r‚glage et config Else Speed&=0 Set_speed!=True Answer!=False Endif ' Gosub Sv.cnf ! sauver config ' Endif ' Fileh&=@Fcreate(Set_path$+"SYSTEME\HISTORY.SYS",0) ~@Fclose(Fileh&) Endif Endif Return ' ' Protection Function Check1 Local A&,B&,C& Local A$,B$,C$ ' A$="V"+"]"+"Z"+"e"+"V" ! ELITE ' ' ' Bidon A&=X_curs& B&=Y_curs& C&=(A&+B&*80)*2 ' If @Crc81(Key$(0))+(Len(Key$(0))=0)<>@Repak1(Mid$(Key$(3),3,2)) Return False Endif ' C&=C&\2 ' ' "ELITE" ? (crackers) A$=Mkl$(Cvl(Left$(A$,4))-&H11111111)+Chr$(Asc(Right$(A$,1))-&H11) If Instr(Key$(0),A$)<>0 A&=&H2170 B&=&H21B0 Slpoke Shr(A&,3),512000 Slpoke Shr(B&,3),512000 Endif A$="G{Le" ' Return True Endfunc ' Procedure Acc_princ3 ! uninit (inusit‚ sauf en test!!) ~@Wind_update01(1) Gosub Uninistr ~Fre(0) ~@Wind_update01(0) Return ' Procedure Sommeil Local A& Local A!,B!,C!,D! Local E$ Local Evnmnt&,Reponse&,Mx&,My&,Mk&,Dummy&,Key&,Clic&,Shift& ' If Menu_adr%>0 Gosub Defmouse(2) For A&=0 To Nbr_idxw& If Wopen!(A&) E$=E$+Chr$(A&) ~@Wind_close(A&) Endif Next A& ' A!=Desk_c! ' B!=Desk_m! C!=Desk_f! D!=Desk_i! ' Desk_c!=False ' Desk_m!=False Desk_f!=False Desk_i!=False Menu_dsk Gosub Defmouse(0) Gosub W_rdexe ' ' 35 ~Menu_bar(Menu_adr%,0) ' Cache_uninit Photo_uninit Io_uninit ~Menu_bar(Adr%(35),1) Do ' Gosub Process ! gestion bouclage GEM ' Evnmnt&=Evnt_multi(&X10000,256+3,3,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),2,Mx&,My&,Mk&,Dummy&,Key&,Clic&) Shift&=@Bios11 ' If Not Set_end! If Btst(Evnmnt&,4) ! messag If Wmenu&(0)=10 Void Menu_tnormal(Adr%(35),Wmenu&(3),1) Select Wmenu&(4) Case X_inf& Gosub Info Case X_cq& ~@Selectk(17,0,17) ! quit Case X_wup& Exit if True Endselect Else Reponse&=@Wmanage(True) ! True: tout g‚rer If Reponse&=-1 ! au secour!!!! Set_end!=True Endif Endif Else if Btst(Evnmnt&,0) ! key ' Select @Geminp(Key&) Case 196,221,27 Exit if True Case 17 Set_end!=True Exit if True Endselect ' Endif ' If Not Set_end! Gosub Msg_bra(Evnmnt&,Reponse&,Key&,Mx&,My&,Mk&,Clic&,Shift&) Else Exit if True Endif Else Exit if True Endif ! if event Loop ~Menu_bar(Adr%(35),0) ' Io_init Photo_init Cache_init ~Menu_bar(Menu_adr%,1) ' ' Desk_c!=A! ' Desk_m!=B! Desk_f!=C! Desk_i!=D! Menu_dsk For A&=1 To Len(E$) ~@Wind_open(Asc(Mid$(E$,A&,1))) Next A& Endif ' Return ' ' $P< Procedure Xxopen ~@Wind_open(4) @W_rdexe ' If Wopen!(4) Gosub Xxappl(Prg_id&,&H1028,Release&,Whandle&(4),0,0,0) ! retour Else Gosub Xxappl(Prg_id&,&H1029,0,0,0,0,0) ! erreur Set_end!=True Endif ' Emul!=True Recept!=False ' Return Procedure Xxsend Local L% Local A%,Adr% ' ' If Wmenu&(1)<>Prg_id& Gosub Xxappl(Wmenu&(1),&H10FF,&H1053,0,0,0,0) ! error ' Else ' L%=Card(Wmenu&(3)) Adr%=Rol(Card(Wmenu&(4)),16)+Card(Wmenu&(5)) ' If Adr%>0 And Even(Adr%) And L%>0 And L%<32768 ' Keepbin(True) Binlen%=L% ! taille If @Tstblk If Binlen%=>L% Bmove Adr%,Binair%,L% Binp%=L% Gosub Envoi(-1) ' Else ~@Form_error(1,"[1][Pas assez de m‚moire|(buffer vid‚otex)][Annuler]") Endif Endif ' Keepbin(False) ' Else Gosub Xxappl(Prg_id&,&H10FF,&H1053,0,0,0,0) ~@Form_error(1,"[1][Erreur de protocole|$1053][Annuler]") ' Endif ' Endif ' Return $P> ' 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 ' Procedure Seqinit(E$) Local N& Local A$,B$ ' If Fsfirst(Set_path$+"SYSTEME",&H10)=-33 A$=Set_path$+"SYSTEME"+Chr$(0) ~Gemdos(57,L:V:A$) Endif ' A$=@Flin$(E$) While Len(A$)>0 N&=Instr(A$,"=") If N&>0 B$=Trim$(Mid$(A$,N&+1)) A$=Upper$(Trim$(Left$(A$,N&-1))) If A$="INIT.HELLO" Hello$=B$ Else if A$="PATH.VDT" Vpath$=@Xpath$(B$) Else if A$="PATH.LOG" Lpath$=@Xpath$(B$) Else if A$="PATH.TXT" Tpath$=@Xpath$(B$) Else if A$="PATH.MAC" Mpath$=@Xpath$(B$) Else if A$="PATH.FACT" Fpath$=@Xpath$(B$) Else if A$="KEEP.VDT" If B$="ON" Or B$="OUI" Vkeep!=True Else Vkeep!=False Endif Else if A$="KEEP.MAC" If B$="ON" Or B$="OUI" Mkeep!=True Else Mkeep!=False Endif Else if A$="KEEP.TXT" If B$="ON" Or B$="OUI" Tkeep!=True Else Tkeep!=False Endif Endif ' Endif ' A$=@Flin$(E$) Wend If Len(Lpath$)=0 Lpath$=@Xpath$("\REPORT\") Endif If Len(Fpath$)=0 Fpath$=@Xpath$("\REPORT\") Endif ' Return Function Xpath$(E$) Local A$ ' E$=Trim$(E$) If Len(E$)>0 If Left$(E$,1)="\" E$=Set_path$+Mid$(E$,2) Endif If Right$(E$,1)<>"\" E$=E$+"\" Endif ' If Fsfirst(Left$(E$,Len(E$)-1),&H10)=-33 A$=E$+Chr$(0) ~Gemdos(57,L:V:A$) Endif Else Clr E$ Endif Return E$ Endfunc ' ' Num‚ros popup Procedure Numpinit(E$) Local A& Local A$ ' Clr Nump$ ! Nom Num‚roOUMacro While Len(E$)>0 A$=Trim$(@Flin$(E$)) If Len(A$)>0 A&=Rinstr(A$," ") If A&>0 Nump$=Nump$+A$+Chr$(10) ' Else ! simple num‚ro Nump$=Nump$+A$+" "+A$+Chr$(10) Endif Endif Wend ' Return Procedure Free_num(Mx&,My&,Mk&) Local A&,B&,C&,N&,X& Local A$,E$,C$ ' Clr N& C$="[" E$=Nump$ While Len(E$)>0 A&=Instr(E$,Chr$(10)) Exit if A&<=0 A$=Left$(E$,A&-1) E$=Mid$(E$,A&+1) A&=Rinstr(A$," ") Exit if A&<=0 C$=C$+Left$(A$,A&-1)+"|" Inc N& Wend C$=C$+"|Ajouter|Supprimer|Sauver]" ' B&=@Free_pop(Mx&,My&,C$) If B&>0 If B&=N&+1 If N&<15 A$=@Dinput$("Ajouter (Nom Num‚ro)","T‚l‚tel 3 3615",X&) If X&<>0 A$=Trim$(A$) If Len(A$)>0 If Instr(A$," ")=0 A$=A$+" "+A$ Endif Nump$=Nump$+A$+Chr$(10) Endif Endif Else ~@Form_alert(1,"[3][Trop d'entr‚es!][Annuler]") Endif Else if B&=N&+2 Nump$="" Else if B&=N&+3 Gosub Save_pop Else if B&<=N& E$=Nump$ For C&=1 To B& A&=Instr(E$,Chr$(10)) A$=Left$(E$,A&-1) E$=Mid$(E$,A&+1) Next C& A&=Rinstr(A$," ") If A&>0 A$=Mid$(A$,A&+1) If Instr(A$,".")<>0 ! macro ~@Macload(Set_path$+"SYSTEME\MACROS\"+A$) ! load Gosub Macexe ! EXEC Else Gosub Dial(A$) Endif Endif Endif Endif ' ' Return Procedure Save_pop Local Fileh&,A& Local A$,E$ ' ~@Wind_update01(1) Fmshow("Sauvegarde de la liste") A$="; Fichier des num‚ros et macros inscrits sur la liste" A$=A$+Mki$(&HD0A)+"; qui peuvent etre appel‚s par un clic sur le premier bouton" A$=A$+Mki$(&HD0A)+"; du clavier de l'‚mulateur"+Mki$(&HD0A)+";"+Mki$(&HD0A) E$=Nump$ While Len(E$)>0 A&=Instr(E$,Chr$(10)) Exit if A&<=0 A$=A$+Left$(E$,A&-1)+Mki$(&HD0A) E$=Mid$(E$,A&+1) Wend A$=A$+Mki$(&HD0A) ' Fileh&=@Fcreate(Set_path$+"SYSTEME\"+"POPUP.SET",0) If @Tsterr(Fileh&) ~@Tsterr(@Fwrite(Fileh&,A$)) ~@Tsterr(@Fclose(Fileh&)) Endif Fmhide ~@Wind_update01(0) ' Return ' ' ' ' Exec appl Procedure Set_exe Local A&,X& Local F$ ' X&=Ex_1&+3 Exdo!=True Do For A&=0 To 3 Char{Ob_spec(Adr%(27),Ex_1&+A&)}=Right$(Menp$(A&),32) Next A& ' A&=Byte(@Form_wdo(27,0)) Ob_state(Adr%(27),A&)=Bclr(Ob_state(Adr%(27),A&),0) $S& Select A& Case Ex_1& To X& ~@Form_wdo(27,-3) F$=@Fsel$("\*.*",Menp$(A&-Ex_1&),"Programme?") If Len(F$)>0 Menp$(A&-Ex_1&)=F$ Endif Exdo!=True ' Gosub Ref_exe Case Ex_aut& Exit if True Case Ex_sv& Exit if True Default Exit if True Endselect Loop ~@Form_wdo(27,-3) ' If A&=Ex_sv& Gosub Save_exe Else if A&=Ex_aut& F$=@Fsel$("\*.*","","Programme?") If Len(F$)>0 ' Go! Gosub Prgl(F$,"") Endif Endif ' Return Procedure Load_exe Local A& Local A$ ' A$=@Finput$("PROGRM.SET") If Len(A$)>0 For A&=0 To 3 Menp$(A&)=@Flin$(A$) Next A& Endif ' Return Procedure Save_exe Local Fileh& Local A$ ' ~@Wind_update01(1) Fmshow("Sauvegarde des noms d'applications") A$="; Fichier des programmes pouvant ˆtre appel‚s"+Mki$(&HD0A) For A&=0 To 3 A$=A$+Menp$(A&) A$=A$+Mki$(&HD0A) Next A& ' Fileh&=@Fcreate(Set_path$+"SYSTEME\"+"PROGRM.SET",0) If @Tsterr(Fileh&) ~@Tsterr(@Fwrite(Fileh&,A$)) ~@Tsterr(@Fclose(Fileh&)) Endif Fmhide ~@Wind_update01(0) ' Return Procedure Ref_exe Local A&,N& Local A$ ' If Menu_adr%>0 For A&=0 To 3 A$=Menp$(A&) N&=Rinstr(A$,"\") If N&>0 A$=Mid$(A$,N&+1) Endif A$=Right$(A$,12) If Len(A$)>0 A$=" "+Chr$(3)+" "+A$+Chr$(0) Else A$=" [CONTROL]-F"+Str$(A&+1)+Chr$(0) Endif ~Menu_text(Menu_adr%,M_run1&+A&,A$) Next A& Endif Return ' ' Programm run! Flag=GEM/TOS E$=Nom C$=Param Procedure Prgl(E$,C$) Local B&,A&,G& Local E% Local A$,B$ ' Local X$ Local S&,N&,P%,R& X$=Space$(16) S&=0 N&=False P%=0 ' If Not Accessoire! If Len(E$)>0 ' If Left$(E$,1)="\" If Not @Fexist(E$) E$=Set_path$+Mid$(E$,2) Endif Endif ' If @Fexist(E$) ' A$=E$ B&=Rinstr(A$,"\") If B&>0 A$=Mid$(A$,B&+1) Endif A$=Right$(A$,12) B&=Rinstr(A$,".") If B&>0 B$=Left$(A$,B&-1) ! NOM A$=Mid$(A$,B&+1) Else B$=A$ ! nom Clr A$ Endif If A$="TTP" Or A$="TOS" G&=0 ! TOS Else G&=1 ! gem Endif ' C$=Chr$(Len(C$))+C$+Chr$(0) E$=E$+Chr$(0) ' For A&=0 To Nbr_idxw& ~@Wind_close(A&) Gosub W_rdexe Next A& ' ~@Wind_update01(1) Cache_uninit ' **** Io_uninit Iofile(False) @Showm Gosub Defmouse(2) ~@Wind_update01(0) @Menu_close ' @Direct(E$) Defmouse 2 If (Multi! And (Magx! Or Mint!)) ~Fre(0) ! GarColl If Magx! N&=1 S&=100 ! // P%=V:E$ Else N&=&H200 X$=Mkl$(V:E$)+Mkl$(0)+Mkl$(-5)+Mkl$(0) P%=V:X$ Endif R&=Shel_write(N&,G&,S&,C$,E$) If R&>0 If (Magx! Or G&) Do ~Evnt_mesag(Varptr(Wmenu&(0))) Exit if Wmenu&(0)=90 ! term Loop If Wmenu&(4)<>0 ' ~@Form_alert(1,@Errf$(Wmenu&(4))) @Menu.info(@Errf$(Wmenu&(4))) Endif Else ~Evnt_timer(100) While Fsfirst("U:\PROC\"+B$+"."+@Xstr$(R&,3),0)=0 ~Evnt_timer(200) Wend Endif ' Else ~@Form_alert(1,"[3][Programme non lanc‚!][Annuler]") Endif ' Else ! simple tƒche ' ~Shel_write(0,G&,0,E$,C$) ~Shel_write(0,G&,0,C$,E$) If G&=0 Void Graf_mouse(256,0) ' Enter alpha mode Contrl(0)=5 Contrl(1)=0 Contrl(3)=0 Contrl(5)=3 Contrl(6)=V~h Vdisys Endif ~@Appl_exit E%=Gemdos(75,0,L:V:E$,L:V:C$,L:0) Void Gemdos(&H1A,L:Dta%) ! PLACER DTA Ap&=@Appl_init If G&=0 ' Exit alpha mode Contrl(0)=5 Contrl(1)=0 Contrl(3)=0 Contrl(5)=2 Contrl(6)=V~h Vdisys Void Graf_mouse(257,0) Endif ~Shel_write(0,1,0,"","") Endif ' @Direct(Set_path$) @Menu_open ~@Wind_update01(1) @Showm Gosub Defmouse(0) ' ****Io_init Iofile(True) Cache_init ' Emul_init ' Drcs_init ~@Wind_update01(0) ' If E%<>0 ' ~@Form_alert(1,@Errf$(E%)) @Menu.info(@Errf$(E%)) Endif ' ~@Wind_open(4) Else ~@Form_alert(1,"[3][Programme non trouv‚!][Annuler]") Endif Endif Else ~@Form_alert(1,"[3][Impossible en ACC!][Annuler]") Endif ' Return ' Procedure Set_transf Local A&,N& Local F$ ' Char{Ob_spec(Adr%(28),Tr_re&)}=Right$(Dwn$,32) Char{Ob_spec(Adr%(28),Tr_em&)}=Right$(Upl$,32) Char{{Ob_spec(Adr%(28),Tr_rex&)}}=Left$(Dwnpar$,32) Char{{Ob_spec(Adr%(28),Tr_emx&)}}=Left$(Uplpar$,32) Exdo!=True Do A&=Byte(@Form_wdo(28,0)) Ob_state(Adr%(28),A&)=Bclr(Ob_state(Adr%(28),A&),0) $S& Select A& Case Tr_re& ~@Form_wdo(28,-3) F$=@Fsel$("\*.*",Dwn$,"Programme r‚ception?") If Len(F$)>0 Dwn$=F$ Char{Ob_spec(Adr%(28),Tr_re&)}=Right$(Dwn$,32) Endif ' Exdo!=True Case Tr_em& ~@Form_wdo(28,-3) F$=@Fsel$("\*.*",Upl$,"Programme ‚mission?") If Len(F$)>0 Upl$=F$ Char{Ob_spec(Adr%(28),Tr_em&)}=Right$(Upl$,32) Endif ' Exdo!=True ' Case Tr_sv&,Tr_ok&,Tr_ann&,0,1 Exit if True ' Endselect Loop ~@Form_wdo(28,-3) ' If A&=Tr_ok& Or A&=Tr_sv& Dwnpar$=Char{{Ob_spec(Adr%(28),Tr_rex&)}} Uplpar$=Char{{Ob_spec(Adr%(28),Tr_emx&)}} ' If A&=Tr_sv& @Save_transf Endif Endif ' Return Procedure Prgtra(A!) Local N& Local A$,B$ ' If A! ! up @Eminfo("Upload..") A$=Upl$ B$=Uplpar$ Else @Eminfo("Download..") A$=Dwn$ B$=Dwnpar$ Endif ' N&=Instr(B$,"$") If N&>0 F$=@Fsel$("\*.*","","Fichier … envoyer?") If Len(F$)>0 B$=Left$(B$,N&-1)+F$+Mid$(B$,N&+1) Else Clr N& Endif Else N&=1 Endif ' If N&>0 Gosub Prgl(A$,B$) Endif Return Procedure Load_transf Local A& Local A$ ' A$=@Finput$("BBS_LOAD.SET") If Len(A$)>0 Dwn$=@Flin$(A$) Upl$=@Flin$(A$) If Left$(Dwn$,1)="\" Dwn$=Set_path$+Mid$(Dwn$,2) Endif If Left$(Upl$,1)="\" Upl$=Set_path$+Mid$(Upl$,2) Endif Dwnpar$=@Flin$(A$) Uplpar$=@Flin$(A$) Endif ' Return Procedure Save_transf Local Fileh& Local A$ ' ~@Wind_update01(1) Fmshow("Sauvegarde des paramŠtres de transfert") A$="; Fichier des paramŠtres de transfert"+Mki$(&HD0A) A$="; Download,Upload,Param download,Param upload - $=nom du fichier"+Mki$(&HD0A) A$=A$+Dwn$+Mki$(&HD0A) A$=A$+Upl$+Mki$(&HD0A) A$=A$+Dwnpar$+Mki$(&HD0A) A$=A$+Uplpar$+Mki$(&HD0A) A$=A$+Mki$(&HD0A) ' Fileh&=@Fcreate(Set_path$+"SYSTEME\"+"BBS_LOAD.SET",0) If @Tsterr(Fileh&) ~@Tsterr(@Fwrite(Fileh&,A$)) ~@Tsterr(@Fclose(Fileh&)) Endif Fmhide ~@Wind_update01(0) ' Return ' ' ' Coul bureau & motifs Procedure Set_desk Local X&,Y& Local C&,S& ' C&=Dcol& S&=Dstyl& X&=Bc_c1&+15 Y&=Bc_s1&+7 Exdo!=True Void @Form_wdo(29,-2) Do Ob_spec(Adr%(29),Bc_box&)=Or(And(Ob_spec(Adr%(29),Bc_box&),&HFFFFFFF0),C&) Ob_spec(Adr%(29),Bc_box&)=Or(And(Ob_spec(Adr%(29),Bc_box&),&HFFFFFF8F),Rol(S&,4)) ~Objc_draw(Adr%(29),Bc_box&,7,Rx&(29),Ry&(29),Rw&(29),Rh&(29)) A&=Byte(@Form_wdo(29,0)) Ob_state(Adr%(29),A&)=Bclr(Ob_state(Adr%(29),A&),0) ~Objc_draw(Adr%(29),A&,7,Rx&(29),Ry&(29),Rw&(29),Rh&(29)) $S& Select A& Case Bc_c1& To X& C&=A&-Bc_c1& Case Bc_s1& To Y& S&=A&-Bc_s1& Default Exit if True Endselect Loop Void @Form_wdo(29,-3) If A&=Bc_ok& Or A&=Bc_sv& Dcol&=C& Dstyl&=S& Ob_spec(Adr%(16),0)=Or(And(Ob_spec(Adr%(16),0),&HFFFFFFF0),Dcol&) Ob_spec(Adr%(16),0)=Or(And(Ob_spec(Adr%(16),0),&HFFFFFF8F),Rol(Dstyl&,4)) Ob_spec(Adr%(16),Dk_bar&)=Or(And(Ob_spec(Adr%(16),Dk_bar&),&HFFFFFFF0),Dcol&) Ob_spec(Adr%(16),Dk_bar&)=Or(And(Ob_spec(Adr%(16),Dk_bar&),&HFFFFFF8F),Rol(Dstyl&,4)) Ob_spec(Adr%(16),Dk_boxc&)=Or(And(Ob_spec(Adr%(16),Dk_boxc&),&HFFFFFFF0),Dcol&) Ob_spec(Adr%(16),Dk_boxc&)=Or(And(Ob_spec(Adr%(16),Dk_boxc&),&HFFFFFF8F),Rol(Dstyl&,4)) ' If A&=Bc_sv& Gosub Save_dsk Endif ' ~Form_dial(3,0,0,0,0,X_desk&,Y_desk&,W_desk&,H_desk&) Endif ' Return Procedure Load_dsk Local A& Local A$ ' A$=@Finput$("DESKCOL.SET") If Len(A$)>0 Dcol&=Max(0,Min(15,Val(@Flin$(A$)))) Dstyl&=Max(0,Min(8,Val(@!$A$)))) Endif Return Procedure Save_dsk Local Fileh& Local A$ ' ~@Wind_update01(1) Fmshow("Sauvegarde du style du bureau") A$="; Couleur&Style bureau"+Mki$(&HD0A) A$=A$+Str$(Dcol&)+Mki$(&HD0A)+Str$(Dstyl&)+Mki$(&HD0A)+Mki$(&HD0A) ' Fileh&=@Fcreate(Set_path$+"SYSTEME\"+"DESKCOL.SET",0) If @Tsterr(Fileh&) ~@Tsterr(@Fwrite(Fileh&,A$)) ~@Tsterr(@Fclose(Fileh&)) Endif Fmhide ~@Wind_update01(0) Return ' ' ' Protection Function Repak2(E$) Return Shl(@Unchar322(Asc(Left$(E$,1))),4)+@Unchar322(Asc(Right$(E$,1))) ' Endfunc ' ' G‚rer tous les msgs sweetel.. Procedure Msg_bra(Evnmnt&,Reponse%,Key&,Mx&,My&,Mk&,Clic&,Shift&) Local Key2& Local A&,B&,C&,Ha& Local B% Local X&,Y&,X2&,Y2&,Dummy& Local T$,A$ ' ' If Btst(Evnmnt&,4) ! Evnt Menu AES If Reponse%<>0 ! Message inconnu? Select Reponse% ' Case &H4700 To &H47FF ! VA_PROTOCOL Gosub Va_bra(Reponse%) ' Case &H1000 To &H10FF ! CALL ' If Wmenu&(1)<>Ap& And Wmenu&(1)=>0 ' $S% Select Reponse% Case &H1028 If Prg_id&=>0 Gosub Xxappl(Wmenu&(1),&H1015,Release&,Whandle&(4),0,0,0) ! oqp! Else Gosub Xxappl(Wmenu&(1),&H10FF,&H1028,0,0,0,0) ! error! Endif ' Case &H1016 ! XXCLOSE If Wmenu&(1)=Prg_id& Gosub Xxappl(Prg_id&,&H1029,0,0,0,0,0) ! closed! Set_end!=True Else Gosub Xxappl(Wmenu&(1),&H10FF,&H1016,0,0,0,0) ! Error! Endif ' Case &H1029 ! XXCLOSE_APP!! Set_end!=True ' Case &H1053 ! send Gosub Xxsend ' Case &H1000 ! version Gosub Xxappl(Wmenu&(1),&H1000,Release&,0,0,0,0) ' Case &H1019 ! leave If Wmenu&(1)=Prg_id& Prg_id&=-1 Prg_lock!=False Recept!=True ! ‚mulation Emul!=True Gosub Xxappl(Prg_id&,&H1019,0,0,0,0,0) Else Gosub Xxappl(Wmenu&(1),&H10FF,&H1019,0,0,0,0) ! Error! Endif ' Case &H101C ! move If Wmenu&(1)=Prg_id& If Btst(Wmenu&(7),0) ! FullScreen Gosub Setfscreen(4) Endif Gosub Setxywh(4,Wmenu&(3),Wmenu&(4),Wmenu&(5),Wmenu&(6)) Gosub W_rdexe Gosub Xxappl(Prg_id&,&H101C,Wmenu&(3),Wmenu&(4),Wmenu&(5),Wmenu&(6),Wmenu&(7)) Else Gosub Xxappl(Wmenu&(1),&H10FF,&H1019,0,0,0,0) ! Error! Endif ' Case &H101D ! Active Window If Wmenu&(1)=Prg_id& If Btst(Wmenu&(3),0) Gemactive!=True Else Gemactive!=False Endif Else Gosub Xxappl(Wmenu&(1),&H10FF,&H1019,0,0,0,0) ! Error! Endif ' Case &H1001 ! change ID If Wmenu&(1)=Prg_id& If Wmenu&(3)=>0 Prg_id&=Wmenu&(3) Gosub Xxappl(Wmenu&(1),&H1001,Prg_id&,0,0,0,0) Gosub Xxappl(Prg_id&,&H1001,Prg_id&,0,0,0,0) Else Gosub Xxappl(Prg_id&,&H10FF,&H1001,0,0,0,0) ! Error! Endif Else Gosub Xxappl(Wmenu&(1),&H10FF,&H1001,0,0,0,0) ! Error! Endif ' Case &H1002 ! Absolute change ID (total control) If Wmenu&(3)=>0 Prg_id&=Wmenu&(3) Else Gosub Xxappl(Prg_id&,&H10FF,&H1001,0,0,0,0) ! Error! Endif ' Case &H1099 ! commande ' Xxappl(Swiftel,$1099,101,0,0,0,0) ' If Wmenu&(1)=Prg_id& Select Wmenu&(3) Case 101 ~@Wind_open(4) Xxappl(Prg_id&,&H1015,0,0,0,0,0) Case 105 @Top(4) Xxappl(Prg_id&,&H1015,0,0,0,0,0) ' Case 1 B%=Rol(Card(Wmenu&(4)),16)+Card(Wmenu&(5)) If B%>0 And Even(B%) @Eminfo(Left$(Char{B%},128)) Endif ' Case -100 ! unLock Prg_lock!=False Case -101 Prg_lock!=True ' Case -1 Gosub Defmouse(2) Gosub Emul_uninit Gosub Emul_init Case -2 Gosub Emulm(0) Case -3 Gosub Emulm(1) Case -4 Gosub Emulm(2) Case -5 Gosub Emulm(3) ' Default Gosub Xxappl(Wmenu&(1),&H10FE,&H1099,Wmenu&(3),0,0,0) ! Error! ' Endselect Else Gosub Xxappl(Wmenu&(1),&H10FF,&H1099,0,0,0,0) ! Error! Endif ' Default Gosub Xxappl(Wmenu&(1),&H10FE,Reponse%,0,0,0,0) ! Error! ' ' Endselect Endif ' 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‚ ' Key&=-Key& ! r‚tablir NAAAAANN!! ' 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 Ha&=-1 A&=@Xfirstw If A&=>0 Gosub Top(A&) ! NewTop Endif Endif Evnmnt&=Word(&X1000000000000001) ! ‚v‚nnement clavier d‚clar‚ Endif Endif ' Endif ! menu install‚ ' Case Ap_dragdrop& ! Drag&Drop @Dmanage ' Case 30,31,32,33 ' Fenˆtre a perdu le 1er plan? Qui sait... ' Default ' @Beep ~@Infow(0,"Window exept #"+Str$(Reponse%)) ' print "Message non trait‚ $"+Hex$(Reponse%) ' 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 ' ' ' Lib‚rer buffer en cas de full etc. If Clp%>0 And (Not Wopen!(3)) ~@Mfree(Clp%) ~@Mfree(Clpref%) Clplen%=0 Else if Iclp%>0 And (Not Wopen!(2)) ! perso PERSO If Clp%>0 ~@Mfree(Iclp%) ~@Mfree(Imf%) 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 ' ' 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: Key2&=Key& ! "v‚ritable" 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 @Racmanage(Key2&,Shift&) If Not @Wkmanage(Key&) ! Non trait‚ par le manager? If Ha&=>0 ! Une de nos fenˆtre est au premier plan? ' ' If Key&=199 If Ha&=4 Key&=1990 Endif Endif ' $S& Select Key& Case 24 ! ^x menu If (Prg_id&<0) Or ((And(Shift&,&X11)<>0)) ~@Wind_open(1) If Wopen!(1) @Top(1) Endif Endif Case 20 ~@Wind_open(4) If Wopen!(4) @Top(4) Ha&=@Firstw If Ha&=4 Gosub Add_menu(Ha&) Endif Else ~@Form_alert(1,"[1]["+"Il n'y a plus de fenˆtres |disponibles sur le bureau! |Fermez en une inutilis‚e. ][Confirmer]") Endif ' Case 22 Gosub Clp_lire(1) Gosub Clp_img(1) ' Case 23 ~@Wind_open(4) ~@Wind_open(1) Gosub Menu.info("Fenˆtres d‚ploy‚es") Case -300 To -1 Key&=-Key& @Selectmnu(Key&) ' Default ' Il faut d‚terminer … qui le caractŠre a ‚t‚ envoy‚: ' ' Control-app? Select Key& Case 187 To 196 If Btst(Shift&,2) ! CTRL! Key&=Key&-187+334 Endif Endselect ' Select Ha& ! CaractŠre pour quelle fenˆtre? ' Case 1 If @Selectk(Key&,Shift&,Key2&)=0 Select @Upcase(Key&) Case "M" ~@Emulek(147,Shift&,True,0) Case "C" ~@Emulek(152,Shift&,True,0) Case "F" ~@Emulek(153,Shift&,True,0) Case "/" ~@Emulek(52,Shift&,True,0) Case "*" ~@Emulek(56,Shift&,True,0) Case "S" ~@Emulek(167,Shift&,True,0) ' Case "N" ' ~@Emulek(666,Shift&,True,0) Default @Selectmnu(Key&) Endselect Endif ' Case 2 If Btst(Evnmnt&,15)=0 ! Non simul‚ If @Imkey(Key&,Shift&,Key2&)=0 ~@Selectk(Key&,Shift&,Key2&)=0 Endif Else ! menu! If @Emulek(Key&,Shift&,-1,Key2&)=0 ~@Selectk(Key&,Shift&,Key2&) Endif Endif ' Case 3 If Btst(Evnmnt&,15)=0 ! Non simul‚ If @Clipkey(Key&,Shift&,Key2&)=0 ~@Selectk(Key&,Shift&,Key2&)=0 Endif Else ! menu! If @Emulek(Key&,Shift&,-1,Key2&)=0 ~@Selectk(Key&,Shift&,Key2&) Endif Endif ' Default ' Select Key& Case 187 To 196 If @Selectk(Key&,Shift&,Key2&)=0 @Selectmnu(Key&) Endif Default If Emul! If @Emulek(Key&,Shift&,Btst(Evnmnt&,15),Key2&)=0 ~@Selectk(Key&,Shift&,Key2&) Endif ' Else If Btst(Evnmnt&,15)=0 ! Non simul‚ If @Selectk(Key&,Shift&,Key2&)=0 ' Minikey(Key&) Endif ' Else ! menu! If @Emulek(Key&,Shift&,-1,Key2&)=0 ~@Selectk(Key&,Shift&,Key2&) Endif Endif ' Endif Endselect ' ' Default ! case 1 ; menu ou autre Endselect ! de ha& ' Endselect ! 1er key& ' Endif ! de If WKmanage Endif ' Endif ! de ha&<>-1 ' Endif ! de evnt-clavier $S% ' ' ' Y a -t- il eu un evnt-souris? If Btst(Evnmnt&,1) ! Evnt SOURIS ' Ha&=Wind_find(Mx&,My&) If Ha&=>1 Ha&=@Windex(Ha&) Else If Menu_adr%>0 Clr Ha& ~Wind_get(0,20,Ha&,A&,A&,A&) If Multi! If Ha&=Ap& ! OK Ha&=1 Else Ha&=-1 Endif ' Else ! si monotache.. ignorer si <=1 (ST!) If Ha&<=1 Ha&=1 Else Ha&=-1 Endif Endif Endif Endif ' If Ha&=>0 ' If Menu_adr%>0 If Not @Wavisible(Ha&,Mx&,My&) ! Coord visible? Ha&=-1 Endif ' Else ' If Ha&=Nbr_idxw& ! pas notre fenˆtre! (imposs.) ' Endif Endif ' ' If Ha&<>Nbr_idxw& And @Wavisible(Ha&,Mx&,My&) ! Coord visible? If Ha&>0 And Ha&0 ! Mouse? ' If Ha&=>0 $S& Select Ha& ' Case 1 If Mk&=2 Comp.info("M","Options..") @Selectmnu(Asc("O")) ! opt Endif Case 4 A&=Shift& If Mk&=1 Gosub Waitpress ~Graf_mkstate(B&,B&,Mk&,B&) If Mk&=1 And A&<>&X100 A&=&X1000 Else if Mk&=0 Mk&=1 Endif Else if Mk&=2 If @Xmousek=0 Clr Mk& Endif Endif ' Select Mk& Case 1 Gosub Clic_eml(Mx&,My&,Mk&,A&) ' Case 2 If Connect! ~@Selectk(193,0,193) Else ' ' Parfois souris non remise en place Gosub Defmouse(0) @Showm ' ~@Selectk(192,0,192) Endif Case 3 ~@Emulek(174,Shift&,-1,0) Endselect ' ' 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 ' Else If (Ha&=Nbr_idxw&) Or (Wind_find(Mx&,My&)=0) ! DESK If Mk&=2 If Connect! ~@Selectk(193,0,193) Else ~@Selectk(192,0,192) Endif Else if Mk&=>1 If Desk_act! Desk_sel(Mx&,My&,Mk&,Clic&) Endif Endif ' Endif ' Endif ' 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 ' Ha&=@Xfirstw If Ha&>0 If Not Set_id! Set_id!=True Set_col(True) Endif Else If Set_id! Set_id!=False Set_col(False) Endif Endif ' If Not @Menu_oqp ' ' If Ha&=4 ' If Not Btst(Evnmnt&,1) ! Evnt SOURIS Void Graf_mkstate(Mx&,My&,Mk&,Shift&) ' Endif ' ~@Wind_update01(11) Gosub Emclic(Mx&,My&,Mk&) ' If Shift&=&X1000 If Not Clipinfo! ~@Infow(4,"i") Clipinfo!=False Endif Else if Shift&=&X100 If Not Clipinfo! ~@Infow(4,"Clic pour couper l'IMAGE") Gosub Defmouse(7) Clipinfo!=True Endif Else if Clipinfo! ~@Infow(4,"Clic sur une commande") Gosub Defmouse(0) Clipinfo!=False Endif ~@Wind_update01(10) ' If @Windex(Wind_find(Mx&,My&))<>4 Gosub Emclic(0,0,0) ! reset infos Endif ' Endif @Test_menu ' ' ' ' If Menu_time! B%=Gemdos(44) If B%<>Lastime% Gosub Drawx(4) If Wopen!(1) ~@Infow(1,"Il est "+Time$+" le "+Date$) Endif Lastime%=B% Endif If @Timsec(B%)-@Timsec(Lastreg%)=>91 ! TTes les 90 secondes Infreg Lastreg%=B% Endif ' Endif ' ' Protection If Startprg%>0 If Len(Falskey$)>0 ! Cl‚ pr‚sente If @Timsec(B%)-@Timsec(Startprg%)=>60*$ And And And And Eqv Xor +3 ! Test protection ' Protection destructrice! ~@Check3 Clr Startprg% Endif Else Clr Startprg% Endif Endif ' If Capt|>0 Gosub Drawx(1) Endif ' If @Gfirstw ! on a le droit If Capt|>0 Gosub Drawx(1) Endif ' ' ~@Wind_update01(11) 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 Endif ' ' ~@Wind_update01(10) Else If Capt|>0 ~@Infow(1,"Capture interrompue (application ou accessoire ‚tranger)") Endif Endif ' ' Endif ! Fin evnt-timer ' ' ' If Desk_act! Ha&=@Xfirstw ! Fenˆtre actuelle? -1=aucune au 1er plan If 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 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& If Wopen!(1) Gosub Top(1) Endif Endif Endif ' Endif Endif Endif ' Endif ! fin test 1e plan ' 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$) Multi_load(E$) ! multi-load $S% Select Upper$(Right$(E$,4)) Case ".VDT",".VID",".MIN" Envoi(-1) ! +envoi si n‚cessaire Endselect $S&‚ Else Menu.info("Fichier "+E$+" introuvable!") Endif Endif Endselect ' Return ' ' drag&drop Procedure Dmanage Local Ha&,Mx&,My&,Shift& Local A& Local Fileh& Local Adr%,Len% Local A$ ' ' Gosub Xxappl(Wmenu&(1),Ap_dragdrop&,0,0,0,0,0) ! error! ' Ha&=@Windex(Wmenu&(3)) ! Index de fenˆtre? Mx&=Wmenu&(4) My&=Wmenu&(5) Shift&=Wmenu&(6) ' ~@Form_alert(1,"[1][Inconnu: $"+Hex$(Wmenu&(7),4)+"][Annuler]") ' Adr%=Fgetdta() Fileh&=@Fopen("U:\PIPE\DRAGDROP."+Mki$(Wmenu&(7)),2) If Fileh&=>0 ' ~@Fwrite(Fileh&,Chr$(0)) ! NAK ' ' Len%=Long{Adr%+26} ' print Len%, ' A$=@Fread$(Fileh&,Len%) ' For A&=1 To Len% ' print Hex$(Asc(Mid$(A$,A&,1)),2);" "; ' Next A& ~@Fclose(Fileh&) Endif ' Return ' ' Protection Function Unchar322(N&) ! EN FAIT 16 att! Select N& Case 65 To 90 Return And(N&-65,&X1111) Case 48 To Return And(N&-48+26,&X1111) Endselect Return 0 Endfunc ' Procedure Multi_load(E$) $S% Select Upper$(Right$(E$,4)) Case ".VDT",".VID",".MIN" File$(2)=E$ @Load.vdt(1) Case ".BLK" File$(4)=E$ Gosub Clp_img(2) ! image! Case ".TXT",".1ST",".DOC",".LST",".HTM","",".ME" File$(3)=E$ Clp_lire(2) Case ".IMG",".GIF",".TGA",".JPG",".PNT",".BMP",".IFF",".PCX",".PCD",".TIF",".TNY",".ART",".FTC",".PIC",".NEO",".DOO",".PNT",".MAC",".PAC",".XGA",".ESM",".GEM",".SEF",".PI1",".PI2",".PI3",".PC1",".PC2",".PC3" ~@Form_alert(1,"[1][Image non g‚r‚e!|Passez sous: |Piccolo ou D2M, BV4..][Confirmer]") Case ".PRG",".TOS",".TTP",".APP",".GTP",".RSC",".CNF",".DAT" ~@Form_alert(1,"[1][Fichier non chargeable!][Annuler]") Default ~@Form_alert(1,"[1]["+Right$(E$,29)+"|Format de fichier inconnu!][Annuler]") Endselect $S& Return ' ' ' Interne, charger INLs Procedure My_load @Printl(Chr$(27)+"E") My_bin(Swsound%,"JMJ",972) My_bin(M_anim%,"M_ANIM",444) My_bin(Cache%,"SW,CACHE",86) My_bin(Clrblk%,"CLROPTI",140) My_bin(Swchar%,"SW,SWCHR",104) My_bin(Qcopy%,"SW,COPY",172) My_bin(Find0%,"SW,FIND0",50) ' ****My_bin(Cachd%,"SW:CACHD",90) ! d‚ja fait en drs_tra (...) agh @Printl("Ok") ~Gemdos(1) Edit Return Procedure My_bin(A%,E$,L%) ! interne au gfa Local A$ Local Adr% ' Adr%=Fgetdta() If A%>0 @Printl("LOAD.. D:\PROGRAMM\GFA\SOURCES.GFA\"+E$+".INL") ' open "I",#1,"D:\PROGRAMM\GFA\SOURCES.GFA\"+E$+".INL" ~Fsfirst("D:\PROGRAMM\GFA\SOURCES.GFA\"+E$+".INL",0) Fileh&=@Fopen("D:\PROGRAMM\GFA\SOURCES.GFA\"+E$+".INL",0) If Fileh&=>0 If L%=Long{Adr%+26} ' Bget #1,A%,Lof(#1) If @Fadrread(Fileh&,A%,L%)<0 ' Else ' Beep @Printl("Erreur len "+E$) ' ~Inp(2) Endif Endif ~@Fclose(Fileh&) ' close #1 Else @Printl("Erreur fichier "+E$) Endif Else @Printl("Erreur adresse "+E$) 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 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 ' ' 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,"[2][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,"[2][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,"[2][Initialiser modem? ][Confirmer| Annuler ]")=1 Gosub Comm.info("M","Initialisation modem") ' Gosub Atsend(Modem$(0)) ! init Gosub Mod_init(False) Endif Endif Endif ~@Wind_update01(0) If Wopen!(1) Rdw_all(1) Endif Gosub Defmouse(0) @Showm ' Return ' ' Initialiser modem Procedure Mod_init(Flag!) Local S&,A& ' S&=Serno& ' If Set_speed! Outvid(V1200b$) ' Else ' Recu!=False Atsend(Modem$(0)) ! init If Len(@Cstr$(Modem$(0)))>0 ! quelque chose a ‚t‚ envoy‚ If Not Recu! ! mais rien en ‚cho Clr A& While (Not Recu!) And (A&<=10) Inc A& Proc_time(100) Wend Endif If Not Recu! ! mais rien en ‚cho If Flag! A&=1 Else A&=@Form_alert(1,"[2][Le modem semble ne pas r‚agir|aux commandes qui lui sont|envoy‚es|R‚glage automatique?][Confirmer|Annuler]") Endif If A&=1 Gosub W_rdexe Gosub Defmouse(2) ~@Wind_update01(1) ' Fmshow("Recherche du port s‚rie") Clr Serno& While Len(Rn$(Serno&))>0 Gosub Defmouse(2) Iofile(True) @Videmntl Recu!=False Atsend(Modem$(0)) ! init If Recu! ! c'est bon! Fmshow("Trouv‚: "+Rn$(Serno&)) ~@Form_alert(1,"[0][Modem trouv‚!][Continuer]") Fmhide Exit if True Endif ' Inc Serno& Wend If Len(Rn$(Serno&))>0 ! trouv‚! If Not Flag! Gosub Opt_save(&X1) Endif Else Serno&=S& Iofile(True) If Flag! A&=1 Else A&=@Form_alert(1,"[2][Aucune r‚ponse.. v‚rifiez les|connexions et la VITESSE de|l'interface! (XCONTROL.CPX)|Dois-je essayer?][Confirmer|Annuler]") Endif If A&=1 ' Clr Serno& While Len(Rn$(Serno&))>0 Iofile(True) ' type BBS, 9600 ~Xbios(15,1,2,138,-1,-1) @Videmntl Recu!=False Atsend(Modem$(0)) ! init If Recu! ! c'est bon! Fmshow("Trouv‚: "+Rn$(Serno&)) ~@Form_alert(1,"[0][Modem trouv‚!][Continuer]") Fmhide Exit if True Endif ' Inc Serno& Wend If Len(Rn$(Serno&))>0 ! trouv‚! If Not Flag! Gosub Opt_save(&X1) Endif Else ~@Form_alert(1,"[2][Aucune r‚ponse.. v‚rifiez les|connexions et la VITESSE de|l'interface! (XCONTROL.CPX)][Annuler]") Endif Endif Endif ' Gosub Defmouse(0) ~@Wind_update01(0) Fmhide Endif Endif Endif Endif Return ' ' ' sous proc Function Selectk(Key&,Shift&,Key2&) $F% Local A&,A%,B% Local A$ Local A! Local O& ' Clr O& If Not Btst(Shift&,3) $S& Select Key& Case 187 O&=Dk_f1& Case 188 O&=Dk_f2& Case 189 O&=Dk_f3& Case 190 O&=Dk_f4& Case 191 O&=Dk_f5& Case 192 O&=Dk_f6& Case 193 O&=Dk_f7& Case 194 O&=Dk_f8& Case 195 O&=Dk_f9& Case 196 O&=Dk_f10& Endselect If O&>0 Clip_off Ob_state(Adr%(16),O&)=Bset(Ob_state(Adr%(16),O&),0) Gosub Drobj(O&) Endif ' Else Select Key& Case 187 To 196 Key&=Key&-186+500 ' Case 212 To 221 ' Key&=Key&-211+500 Endselect Endif ' A&=@Upcase(Key&) ' ' $S& ' Select A& ' Case 5,18,19,287,17,305,405,187 To 196,3Tarif33 To ' A&=Key& A&=@Upcase(Key&) ' $S& Select A& Case 0 Case 510 Gosub Sommeil ' Case 508 ! Tarificateur Gosub Set_tar ' Case 507 ! Couper adresse Gosub Adrcut ' Case 506 Gosub Vdt2ascii Case 504 ! sF1 coder Gosub Envslow Case 501 Menu.info("Mode vid‚otex, 40 colonnes") Emulm(0) Case 502 Menu.info("Mode vid‚otex, 80 colonnes") Emulm(1) Case 503 Menu.info("Mode terminal ANSI VT-100, "+Str$(Xterm&)+" colonnes") Emulm(3) Case 505 @Opt_save(0) ' Case 349 ! aller ….. Go_mag ' Case 348 ! coldesk Set_desk ' Case 344 Set_transf Case 345 Prgtra(False) Case 346 Prgtra(True) ' Case 347 A$=@Fsel$("\*.*","","Programme?") If Len(A$)>0 Gosub Prgl(A$,"") Endif ' Case 333 ! exec Gosub Set_exe ' Case 334 To 343 ! ^F1 … ^F10 If A&<=337 Gosub Prgl(Menp$(A&-334),"") Endif ' Case 190,192,193 ! fnction emulateur ~@Emulek(Key&,Shift&,True,Key2&) ' Case 189 ! options Gosub Set_opt ' Case 196 If @Form_alert(1,"[2][Quitter Swiftel III |et retourner au bureau?][Quitter| Annuler ]")=1 ' Auto macro If @Exist(Set_path$+"SYSTEME\MACROS\"+"END"+".SPM") ! load ~@Macload(Set_path$+"SYSTEME\MACROS\"+"END"+".SPM") ! load Gosub Macexe ! EXEC Endif Set_end!=True Endif ' Case 17 ! quit ' Auto macro If @Exist(Set_path$+"SYSTEME\MACROS\"+"END"+".SPM") ! load ~@Macload(Set_path$+"SYSTEME\MACROS\"+"END"+".SPM") ! load Gosub Macexe ! EXEC Endif ' Comm.info("","") Gosub Menu.info(Title$) ~@Infow(4,"Vous quittez SwifteL!.. a bient“t!") Set_end!=True ' Case 191 ! Recevoir f5 Gosub Recept Case 305 Gosub Envoi(2) Case 405 Gosub Envoi(1) Case 5 ! Envoyer ^E Gosub Envoi(1) Case 18 ! ^Record Menu.info("Enregistrement") If @Tstblk If Magneto&<=0 If Magneto&=0 Capt|=1 Mgstate(-1) ! REC! Else Magn(6) Endif Else @Beep Endif Endif ' Case 19 ! ^Save ou s^Stop If And(Shift&,&X11)<>0 Menu.info("D‚coupage de la page") Keepbin(True) ! 'sauver' buffer! If @Tstblk Emcut(0) @Saveclp Endif Keepbin(False) ! 'sauver' buffer! Else Menu.info("Stop") ' ' Copie de Magn(6) Capt|=False Mgstate(0) ' If Binp%>0 ' Gosub Save.vdt(0) ' Endif ' ' Magn(6) Endif ' Case 16 ! ^Pause If And(Shift&,&X11)<>0 Menu.info("Impression de la page") Keepbin(True) ! 'sauver' buffer! If @Tstblk Emcut(0) @Printbnr Endif Keepbin(False) ! 'sauver' buffer! Else Menu.info("Pause") Magn(5) Endif ' Case 1 ! ^Ascii texte (charger) Clr Binp% @Load.vdt(-2) ' Case 21 ! ^Upload Menu.info("Upload") Prgtra(True) ' Case 4 ! ^Download Menu.info("Download") Prgtra(False) ' Case 194 ! infos fichier File$=@Fsel$("\*.*",File$,"Infos") If Len(File$)>0 If Fsfirst(File$,0)=>0 ' A%=Fgetdta() B%=Long{A%+26} A%=Byte{A%+21} ' 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,"[2][Fichier: "+Right$(File$,20)+" |Taille: "+Str$(B%)+"o |Attributs: "+A$+" ][Confirmer]") @Comm.info("M",Right$(File$,20)+" - "+Str$(B%)+"o / "+A$) ' Else ~@Wind_update01(0) ~@Form_alert(1,Errn33$) Gosub Comm.info("Infos fichier","Fichier introuvable") Endif Else Gosub Comm.info("Infos fichier","annul‚") Endif ' Case 195 ! 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,Errn33$) Gosub Comm.info("D‚truire fichier","Fichier introuvable") Endif Else Gosub Comm.info("D‚truire fichier","annul‚") Endif ' Case 187 ! f1 load bin Clr Binp% @Load.vdt(True) ' @Videkbd If Binp%>0 Gosub Envoi(1) Endif Case 287 ! TXT Clr Binp% @Load.vdt(-2) ' @Videkbd ' Case 188 ! f2 save bin @Save.vdt(0) ' @Videkbd ' Default Return 0 Endselect $S% ' If O&>0 Clip_off Ob_state(Adr%(16),O&)=Bclr(Ob_state(Adr%(16),O&),0) Gosub Drobj(O&) Endif ' Return -1 Endfunc Procedure Selectmnu(Key&) Local X&,A% ' $S& A&=@Upcase(Key&) ' ' Key&=Asc(Upper$(Chr$(Key&))) ' If help! ' X&=Key& ' Gosub help(1,X&) ' Key&=X& ' Clr X& ' Endif Select @Upcase(Key&) Case 0 ' Case "E" ! effacer Gosub Comm.info("M","Ecran effac‚") Outvid(Reset$+Cll$+Cls$) ' @Videkbd Case "R",147 ! init ^R,\R Gosub Mres(Key&) Case 146 ! envoyer clavier \E Gosub Envslow ' Case "O",16 ! Options Gosub Set_opt ' Case "T" ! taille texte Gosub Select_text(False) ' ' Case "L" ! NormV ' slow!=Not slow! ' If Wopen!(1) ' Rd_all(1,W_ix&(1),W_iy&(1),W_iw&(1),W_ih&(1)) ' Endif ' @Videkbd ' If slow! ' Gosub Comm.info("M","Vitesse"+" lente 75b") ' Else ' Gosub Comm.info("M","Vitesse"+" normale") ' Endif ' Gosub Menu_set ' Case "I",151,9,"?" If Key&=Asc("?") And @Mousek=1 ! perso Compinf$(0)="MemAlloc: "+Str$(Malloc(-1)) Compinf$(1)="MemFree: "+Str$(Fre(0)) Compinf$(2)="ApId: "+Str$(Ap&) Compinf$(3)="Wh1: "+Str$(Whandle&(1)) Compinf$(4)="Wh4: "+Str$(Whandle&(4)) Compinf$(5)="Wop1,4: "+Str$(Wopen!(1))+","+Str$(Wopen!(4)) Compinf$(6)="" For X&=1 To Min(8*20,Len(Malloc$)) Step 8 Compinf$((X&-1)\8+7)="Bloc "+Str$(Cvl(Mid$(Malloc$,X&+4,4)),10)+"o en $"+Hex$(Cvl(Mid$(Malloc$,X&,4)),8) Next X& ' Select @Form_alert(1,"[2][Stop? ][ Brk |Interrupt | Annuler ]") Case 1 Stop Case 2 Select @Form_alert(1,"[2][Stop? ][ Interrupt | IER | Annuler ]") Case 1 Monitor Case 2 Error 100 Endselect Endselect Rdw_all(1) ' Else ' @Defmouse(0) @Showm Gosub Info @Showm Endif ' Case 23 ~@Wind_open(1) ~@Wind_open(4) @W_rdexe Gosub Menu.info("Toute fenˆtres ouvertes") ' Case 13 ! redraw all @Print(Chr$(27)+"H") Gosub Defmouse(2) ~Form_dial(3,0,0,0,0,X_desk&,Y_desk&,W_desk&,H_desk&) W_rdexe Gosub Defmouse(0) Videkbd Case 26 ! ^Z Casse brique Gosub Menu.info("Non disponible...") ' Default Gosub Menu.info("Touche inconnue #"+Str$(Key&)+" ("+Chr$(Key&)+")") Endselect $S% Return ' Procedure Set_opt Local A&,X& Local A!,B!,C!,D! ' ' ReGet_rs A&=Serno& Iofile(False) Gosub Get_rs Serno&=A& Iofile(True) ' Char{{Ob_spec(Adr%(1),Rsc_vl&)}}=Str$(Binsz%,6) ' ' Gosub Sel_pop(Adr%(1),Rsc_vdt&,Abs(Acc!)+1) ' Gosub Sel_pop(Adr%(1),Rsc_cod&,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 ' Rselect(Rsc_hlp&,Menu_hlp!) ' Rselect(Rsc_tc2&,Desk_m!) ! Rselect(Rsc_tc&,Desk_c!) ! ' Rselect(Rsc_hlp&,Desk_m!) Rselect(Rsc_tf&,Desk_f!) ! touches f Rselect(Rsc_ti&,Desk_i!) ! icones ' Rselect(Rsc_fq&,Fastquit!) ' Rselect(Rsc_eff&,Effect!) ' Rselect(Rsc_nice&,Nice!) ' Rselect(Rsc_log&,Log!) ' Rselect(Rsc_col&,Mcol!) ' Rselect(Rsc_gris&,Gris!) ' Gosub Sel_pop(Adr%(1),Rsc_ser&,Serno&+1) ' Exdo!=True Do A&=Byte(@Form_wdo(1,0)) Select A& Case Rsc_mod& Rselect(A&,False) ~@Form_wdo(1,-3) Gosub Set_mdm Exdo!=True ~@Form_wdo(1,-2) Case Rsc_rep& Rselect(A&,False) ~@Form_wdo(1,-3) Gosub Intercall(False) Exdo!=True ~@Form_wdo(1,-2) Case Rsc_reg& Rselect(A&,False) ~@Form_wdo(1,-3) ~@Emulek(147,0,True,0) Exdo!=True ~@Form_wdo(1,-2) Case Rsc_sty& Rselect(A&,False) ~@Form_wdo(1,-3) ~@Emulek(167,0,True,0) Exdo!=True ~@Form_wdo(1,-2) Case Rsc_parx& Rselect(A&,False) ~@Form_wdo(1,-3) Gosub Rim_uninit Gosub Parx_def Gosub Rim_init Exdo!=True ~@Form_wdo(1,-2) Default Exit if True Endselect Loop ' Rselect(A&,False) ~@Wind_update01(0) ~@Form_wdo(1,-3) Gosub W_rdexe ' Select A& Case Rsc_ok&,Rsc_save& ' If Val(Char{{Ob_spec(Adr%(1),Rsc_vl&)}})<>Binlen% ~@Mfree(Binair%) Binsz%=Max(Min(9999999,Val(Char{{Ob_spec(Adr%(1),Rsc_vl&)}})),Minbin&) Binlen%=Max(Min(Malloc(-1)-8192,Min(9999999,Binsz%)),Minbin&) ' Buffer vid‚otex ~@Tstblk Endif ' Menu_hlp!=Btst(Ob_state(Adr%(1),Rsc_hlp&),0) ' A!=Btst(Ob_state(Adr%(1),Rsc_tc&),0) B!=Btst(Ob_state(Adr%(1),Rsc_tc2&),0) ' B!=Btst(Ob_state(Adr%(1),Rsc_tm&),0) C!=Btst(Ob_state(Adr%(1),Rsc_tf&),0) D!=Btst(Ob_state(Adr%(1),Rsc_ti&),0) If C!<>Desk_f! Or D!<>Desk_i! Or B!<>Desk_m! ' Desk_c!=A! Desk_m!=B! Desk_f!=C! Desk_i!=D! Gosub Menu_dsk Gosub Desk_hide Gosub Drobj(0) ! tout dessiner! Endif If A!<>Desk_c! Set_deskc(A!) If Nice! Gosub Nice4 Endif Endif ' Fastquit!=Btst(Ob_state(Adr%(1),Rsc_fq&),0) ' Effect!=Btst(Ob_state(Adr%(1),Rsc_eff&),0) ' Log!=Btst(Ob_state(Adr%(1),Rsc_log&),0) ' Mcol!=Btst(Ob_state(Adr%(1),Rsc_col&),0) ' Gris!=Btst(Ob_state(Adr%(1),Rsc_gris&),0) ' If Btst(Ob_state(Adr%(1),Rsc_nice&),0)<>Nice! Nice!=Not Nice! If Nice! Gosub Nice4 Gosub Rdw_all(4) Else ~@Wind_close(4) Wset_flags(4,&X100111111111111) ! Tous les attributs ~@Wind_open(4) @W_rdexe Endif Endif ' ' Acc!=(@State_pop(Adr%(1),Rsc_vdt&)=2) ' ' Ascii&=@State_pop(Adr%(1),Rsc_cod&)-1 ' Serno&=@State_pop(Adr%(1),Rsc_ser&)-1 Gosub Iofile(True) ! open device ' Gosub Recol ! chnge col ' X&=@State_pop(Adr%(1),Rsc_1200&)-1 If Speed&<>X& Speed&=X& If X&=4 Answer!=True ! r‚pondre @Setspeed Set_speed!=False Gosub Comm.info("M","Initialisation modem") ' Gosub Atsend(Modem$(0)) ! init Gosub Mod_init(False) Else Answer!=False ! ne plus r‚pondre 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 A&=Rsc_save& ' Gosub Sv.cnf Gosub Opt_save(&X11) Endif ' Endselect $S% ' Return ' ' F&: 1 Envoi -1 Auto Procedure Envoi(F&) Local A&,B%,C&,X& Local N& Local B!,C! Local T%,D% ' ' If Magneto&=0 If Binp%=0 @Load.vdt(True) Endif ' If Binp%<>0 Mgstate(1) ' ' actb&=0 ! Bloc 0 par d‚faut Exdo!=True ' Char{{Ob_spec(Adr%(22),En_no&)}}=Str$(Len(binair$),5) Char{{Ob_spec(Adr%(22),En_no&)}}=Str$(Binp%,8) Gosub Sel_pop(Adr%(22),En_slw&,Lim1200&+1) If F&<>0 ' Ob_state(Adr%(22),En_min&)=Bclr(Ob_state(Adr%(22),En_min&),0) ' Ob_state(Adr%(22),En_scr&)=Bclr(Ob_state(Adr%(22),En_scr&),0) ' Ob_state(Adr%(22),En_two&)=Bclr(Ob_state(Adr%(22),En_two&),0) If Abs(F&)=1 Gosub Sel_pop(Adr%(22),En_dest&,2) ' Ob_state(Adr%(22),En_scr&)=Bset(Ob_state(Adr%(22),En_scr&),0) Else Gosub Sel_pop(Adr%(22),En_dest&,1) ' Ob_state(Adr%(22),En_min&)=Bset(Ob_state(Adr%(22),En_min&),0) Endif ' Endif ' If F&<>-1 Do ' If Len(binair$)=0 If Binp%=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&,1 Exit if True Endselect ' Loop ~@Wind_update01(0) Desel(22,A&) ' ~form_dial(3,0,0,0,0,Rx&(22),Ry&(22),Rw&(22),Rh&(22)) ~@Form_wdo(22,-3) Gosub W_rdexe Else ~@Wind_update01(0) A&=En_env& Endif ' Select A& Case En_ok&,En_env& ' Vers le minitel? Redt|=0 Select @State_pop(Adr%(22),En_dest&) Case 1 Redir!=False Case 3 Redir!=True Redt|=1 ! 1=les deux Case 2 Redir!=True Endselect ' Lim1200&=(@State_pop(Adr%(22),En_slw&))-1 Select Lim1200& Case 0 N&=5 ! 1/10 ligne Case 1 N&=12 ! >1/2 ligne Case 2 N&=240 ! 6 lignes Default N&=1024 ! vachement rapide (9600 bauds) Endselect If Btst(Ob_state(Adr%(22),En_wait&),0) Mwait!=True Else Mwait!=False Endif Endselect ' If A&=En_env& And @Tstblk ' If Len(binair$)>0 If Binp%>0 ' Gosub Defmouse(2) ' ' Gosub Drcurs(False) ! vcurs(0) Gosub Menu.info("Envoi en cours.. ["+Str$(Lim1200&)+"]") ' ' For A&=1 To Len(binair$(actb&))+(n-1) Step n If Redir! @Top(4) ! topped! Gosub Set_col(True) Swt&=1 ~@Infow(4,"Visualisation en cours..") Else ~@Infow(4,"Envoi en cours..") ' Gosub Progress(False,0,"Envoi vers le minitel") Endif ' ~@Wind_update01(0) Gosub Defmouse(0) Magpos%=0 Gosub Magc B%=0 ' On laisse effacer.. Okwait!=False C!=False If Mwait! Okwait!=True Oktype|=0 Okw%=0 C!=True Else @Vcls(True) ! pas besoin de reset donc.. Okwait!=False Endif Gosub Loc_reset ! reset vid‚otex local.. Do ' If Magneto&=1 ! Ok <> 2 ' ' ~@Wind_update01(1) ~@Wind_update01(11) ' If Not Rafale! Gosub Sw_clip @Hidem Endif ' B!=Answer! Answer!=False ! ne pas r‚pondre aux demandes de status!! Set_send!=True ! envoi! ' If Okwait! ' C!=True ! d‚ja un avant! Gosub Vcls(True) ' Okwait!=False ! fait Endif Adrsend(Binair%+Magpos%,Min(Binp%-Magpos%,N&),Not Rafale!) ' If Okwait! If C! ! encore un? If Okw%<=16 ! ca vaut pas le coup.. continuer! Sub Magpos%,N&-Okw% Okwait!=False Endif Endif Else Clr C! ! ya plus Endif If Okwait! ! wait normal ' C!=True ! not‚ avant ' ' If Rafale! ! fait aprŠs ' Gosub Vrefresh ' Gosub Sw_clip ' Endif ' ~@Wind_update01(10) Mgstate(2) ! pause! Gosub Magc ~@Wind_update01(11) Sub Magpos%,N&-Okw% ' ''' Sub Magpos%,N&-A&+1 ' ''C!=True ! ignorer prochain CLS Endif ' Answer!=B! Set_send!=False ' If Rafale! Gosub Vrefresh Else @Showm Endif ' ' ~@Wind_update01(0) ~@Wind_update01(10) ' Add Magpos%,N& If Magpos%-B%>40 Or Magpos%2 T%=D% B%=Magpos% Gosub Magc Endif Endif ' If Lim1200&=0 ' Add L1200&,n ! limitateur de vitesse Waitimer Endif Endif ' If Imp(Spdp!,Not Photo!) Gosub Process ! gestion bouclage GEM Endif ' If (Not Wopen!(4)) Or Set_end! Or Magneto&<=0 ! ferm‚! Magpos%=-1 Endif ' ' Loop until Magpos%>Len(binair$)+(N&-1) Or Magpos%=0 Loop until Magpos%=>Binp% Or Magpos%=-1 Magpos%=-1 Clr Swt& ' Next A& ' Gosub Drcurs(True) ! vcurs(1) Gosub Comm.info("M","Envoy‚") @Showm ' Gosub Defmouse(0) ~@Wind_update01(0) ' @Videkbd Else ~@Form_alert(1,"[1][Buffer vide! ][ Annuler ]") Endif ! vide! Endif ! ok? Mgstate(0) ! ok libre ' Else ! annul‚ Mgstate(0) Endif ' Else If Magneto&=-1 ~@Form_alert(1,"[1][Enregistrement en cours!][Continuer]") Mgstate(Magneto&) Else if Magneto&<=0 @Beep Mgstate(Magneto&) Else Select Form_alert(1,"[2][Voulez-vous interrompre la |visualisation?][Confirmer|Pause|Annuler]") Case 1 Magpos%=-1 Case 2 Magn(5) Endselect Endif ' Endif ' Return Procedure Envslow Local A% Local A&,X&,B&,T& Local N&,O& ' If Magneto&=0 If @Tstblk ' Exdo!=True Char{{Ob_spec(Adr%(23),Ens_len&)}}=Str$(Binp%,8) N&=0 Gosub Sel_pop(Adr%(23),Ens_spd&,N&+1) O&=0 Gosub Sel_pop(Adr%(23),Ens_pau&,O&+1) Gosub Sel_pop(Adr%(23),Ens_asc&,Ascii&+1) ' A&=Byte(@Form_wdo(23,0)) N&=@State_pop(Adr%(23),Ens_spd&)-1 O&=@State_pop(Adr%(23),Ens_pau&)-1 Ascii&=@State_pop(Adr%(23),Ens_asc&)-1 ~@Form_wdo(23,-3) ' Ob_state(Adr%(23),A&)=Bclr(Ob_state(Adr%(23),A&),0) Desel(23,A&) ~@Wind_update01(0) Gosub W_rdexe ' ' ' If Form_alert(1,"[2][Envoi du buffer pour serveur..|CR -> SUITE / CHR<32 -> $XX][Confirmer|Annuler]")=1 If A&=Ens_ok& ' If Binp%>0 Mgstate(10) ! slow ' Gosub Menu.info("SHIFT-SHIFT: STOP / CTRL: + / ALT: PAUSE") Gosub Menu.info("CTRL: +vite / ALT: PAUSE") Lastsend|=25 Redir!=True Set_send!=True ! envoi! ' Magpos%=0 Do ' If Magneto&=10 Or Magneto&=12 Clr T& ' ~@Wind_update01(1) ~@Wind_update01(11) X&=@Shift ' ' B&=Asc(Mid$(binair$,Magpos%,1)) B&=Byte{Binair%+Magpos%} Select B& ' Case "Ý" If O&=2 ~@Wind_update01(10) Mgstate(11) ! pause auto! ~@Wind_update01(11) Else Fsend("Ý") Endif Case 10 Case 13 If O&=1 Or Magneto&=12 ~@Wind_update01(10) Mgstate(11) ! pause auto! ~@Wind_update01(11) Else Fsend(Chr$(19)) If X&<>&X100 ! CONTROL Inc T& ! 7.5c/s eh oui sur 10 bits! Endif Fsend("H") ! Suite, Sep H If X&<>&X100 ! CONTROL Inc T& Inc T& Endif Endif ' Case 0 To 31 $S& Select Ascii& Case 1 Select B& Case 0 To 26,28 To 31 Fsend("$") If X&<>&X100 ! CONTROL Inc T& Endif Fsend(Chr$(64+B&)) If X&<>&X100 ! CONTROL Inc T& Endif Case 27 Fsend("#") If X&<>&X100 ! CONTROL Inc T& Endif Endselect Case 0 Select B& Case 0 To 15 Fsend("$") If X&<>&X100 ! CONTROL Inc T& Endif Fsend("0") If X&<>&X100 ! CONTROL Inc T& Endif Fsend(Hex$(B&,1)) If X&<>&X100 ! CONTROL Inc T& Endif Case 0 To 26,28 To 31 Fsend("$") If X&<>&X100 ! CONTROL Inc T& Endif Fsend(Hex$(B&,2)) If X&<>&X100 ! CONTROL Inc T& Inc T& Endif Case 27 Send2("#") If X&<>&X100 ! CONTROL Inc T& Endif Endselect Case 2 Tran(Chr$(B&)) Fdsend(Tr_t$) If X&<>&X100 ! CONTROL Inc T& ! 7.5c/s eh oui sur 10 bits! Endif Endselect $S% Case 32 To Tran(Chr$(B&)) Fdsend(Tr_t$) If X&<>&X100 ! CONTROL Inc T& ! 7.5c/s eh oui sur 10 bits! Endif Endselect Select X& Case &X1000 ! pause, ALT Gosub Menu.info("Pause, relachez") While @Shift<>0 Wend Gosub Menu.info("Envoi en cours.. ctrl: stop, shft: pause") Endselect Inc Magpos% ' ~@Wind_update01(0) ~@Wind_update01(10) ' Gosub Magc If T&>0 If N&=0 ~Evnt_timer(133*T&) ! 7.5c/s Endif Endif ' Endif ' Set_send!=False Gosub Process ! gestion bouclage GEM @Tmanage(True) ! juste capture & ‚mul.. (si besoin!) Set_send!=True ' If (Not Wopen!(4)) Or Set_end! Or Magneto&<=0 ! ferm‚! Magpos%=-1 Endif ' Loop until Magpos%=>Binp% Or Magpos%=-1 Magpos%=-1 Set_send!=False ' Gosub Comm.info("M","Envoy‚") ' Gosub Defmouse(0) ' ~@Wind_update01(0) ' @Videkbd Else ~@Form_alert(1,"[1][Buffer vide! ][ Annuler ]") Endif Endif Mgstate(0) Endif Else If Magneto&=-1 ~@Form_alert(1,"[1][Enregistrement en cours!][Continuer]") Else if Magneto&<=0 @Beep Else If Form_alert(1,"[2][Voulez-vous interrompre la |visualisation?][Confirmer|Annuler]")=1 Magpos%=-1 Endif Endif Endif ' Return ' Procedure Process Local Evnmnt&,Reponse&,Mx&,My&,Mk&,Dummy&,Key&,Clic&,Shift& ' ~@Wind_update01(0) Repeat ' Evnmnt&=Evnt_multi(&X110001,0,0,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),0) Evnmnt&=Evnt_multi(&X110011,256+3,3,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),2,Mx&,My&,Mk&,Dummy&,Key&,Clic&) Shift&=@Bios11 ' If Evnmnt&<>&X100000 ! message/clavier If Not Set_end! If Btst(Evnmnt&,4) ! messag Reponse&=@Wmanage(True) ! True: tout g‚rer If Reponse&=-1 ! au secour!!!! Set_end!=True Endif Endif ' If Not Set_end! Gosub Msg_bra(Evnmnt&,Reponse&,Key&,Mx&,My&,Mk&,Clic&,Shift&) Else Exit if True Endif Else Exit if True Endif ! if event Until Evnmnt&=&X100000 ! message ok (timer=fin) ' Return ' ' Attendre n% millisecondes Procedure Proc_time(N%) Local T% T%=Timer While (Timer-T%)0 ~Objc_offset(Adr%(16),O&,X&,Y&) ' X&=Ob_x(Adr%(16),O&) ' Y&=Ob_y(Adr%(16),O&) W&=Ob_w(Adr%(16),O&) H&=Ob_h(Adr%(16),O&) ' W&=32 ' H&=32 Select Ob_type(Adr%(16),O&) Case 25 ! d‚placer barre? If O&=Dk_bar& ~Objc_offset(Adr%(16),Dk_bar&,X&,Y&) ~Graf_dragbox(Ob_w(Adr%(16),Dk_bar&),Ob_h(Adr%(16),Dk_bar&),X&,Y&,X_desk&,Y_desk&,W_desk&,H_desk&,X&,Y&) If @Mousek=0 Ob_flags(Adr%(16),Dk_bar&)=Bset(Ob_flags(Adr%(16),Dk_bar&),7) ! hidetree Gosub Drobj(Dk_bar&) Ob_flags(Adr%(16),Dk_bar&)=Bclr(Ob_flags(Adr%(16),Dk_bar&),7) ! hidetree Ob_x(Adr%(16),Dk_bar&)=X&-Ob_x(Adr%(16),0) Ob_y(Adr%(16),Dk_bar&)=Y&-Ob_y(Adr%(16),0) Gosub Drobj(Dk_bar&) Endif Else if O&=Dk_boxc& ~Objc_offset(Adr%(16),Dk_boxc&,X&,Y&) ~Graf_dragbox(Ob_w(Adr%(16),Dk_boxc&),Ob_h(Adr%(16),Dk_boxc&),X&,Y&,X_desk&,Y_desk&,W_desk&,H_desk&,X&,Y&) If @Mousek=0 Ob_flags(Adr%(16),Dk_boxc&)=Bset(Ob_flags(Adr%(16),Dk_boxc&),7) ! hidetree Gosub Drobj(Dk_boxc&) Ob_flags(Adr%(16),Dk_boxc&)=Bclr(Ob_flags(Adr%(16),Dk_boxc&),7) ! hidetree Ob_x(Adr%(16),Dk_boxc&)=X&-Ob_x(Adr%(16),0) Ob_y(Adr%(16),Dk_boxc&)=Y&-Ob_y(Adr%(16),0) Gosub Drobj(Dk_boxc&) Endif Endif ' Case 31,33 ! ic“nes If Clic&=1 ! simple clic If And(T&,&X11)=0 Gosub Undsk Endif ' If And(T&,&X11)=0 Ob_state(Adr%(16),O&)=Bchg(Ob_state(Adr%(16),O&),0) Else Ob_state(Adr%(16),O&)=Bset(Ob_state(Adr%(16),O&),0) Endif Gosub Drobj(O&) ' Else if Clic&=0 A&=X&-Mx& B&=Y&-My& ' Clr X2& N&=-1 Repeat Inc N& Select Ob_type(Adr%(16),N&) Case 31,33 If Btst(Ob_state(Adr%(16),N&),0) Inc X2& Endif Endselect Until Btst(Ob_flags(Adr%(16),N&),5) ! lastob ' If (Btst(Ob_state(Adr%(16),O&),0) And X2&>$ And And And And Imp $And(T&,&X11)<>0 ! d‚placement group‚ If Not Btst(Ob_state(Adr%(16),O&),0) Ob_state(Adr%(16),O&)=Bset(Ob_state(Adr%(16),O&),0) Gosub Drobj(O&) Endif ' Clr X2&,Y2&,W2&,H2& X2&=X_desk&+W_desk& Y2&=Y_desk&+H_desk& N&=-1 Repeat Inc N& Select Ob_type(Adr%(16),N&) Case 31,33 If Btst(Ob_state(Adr%(16),N&),0) X2&=Min(X2&,Ob_x(Adr%(16),N&)) Y2&=Min(Y2&,Ob_y(Adr%(16),N&)) W2&=Max(W2&,Ob_x(Adr%(16),N&)+Ob_w(Adr%(16),N&)) H2&=Max(H2&,Ob_y(Adr%(16),N&)+Ob_h(Adr%(16),N&)) Endif Endselect Until Btst(Ob_flags(Adr%(16),N&),5) ! lastob ' Pbox X2&,Y2&,W2&,H2& W2&=W2&-X2&+1 H2&=H2&-Y2&+1 X2&=X2&+X_desk& Y2&=Y2&+Y_desk& Gosub Defmouse(4) ~Graf_dragbox(W2&,H2&,X2&,Y2&,X_desk&,Y_desk&,W_desk&,H_desk&-Ob_h(Adr%(16),Dk_bar&),X&,Y&) Gosub Defmouse(0) If @Mousek=0 A&=X&-X2& B&=Y&-Y2& N&=-1 Repeat Inc N& Select Ob_type(Adr%(16),N&) Case 31,33 If Btst(Ob_state(Adr%(16),N&),0) Ob_flags(Adr%(16),N&)=Bset(Ob_flags(Adr%(16),N&),7) Gosub Drobj(N&) Ob_flags(Adr%(16),N&)=Bclr(Ob_flags(Adr%(16),N&),7) X&=Ob_x(Adr%(16),N&) Y&=Ob_y(Adr%(16),N&) ' If Mod(X&,8)<>0 X&=(X&\8-(Mod(X&,8)>3))*8 Endif If Mod(Y&,8)<>0 Y&=(Y&\8-(Mod(Y&,8)>3))*$ And And And And Eqv Xor Endif ' Ob_x(Adr%(16),N&)=X&+A& Ob_y(Adr%(16),N&)=Y&+B& Gosub Drobj(N&) Endif Endselect Until Btst(Ob_flags(Adr%(16),N&),5) ! lastob Endif ' Else ! d‚placement normal d'une ic“ne Gosub Undsk ! effacer s‚lection ' Ob_state(Adr%(16),O&)=Bset(Ob_state(Adr%(16),O&),0) Gosub Drobj(O&) ' Clip(X_desk&,Y_desk&,W_desk&,H_desk&) @Lhidem Contrl(0)=113 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=&X1010101010101010 Vdisys Defline 7 ' Graphmode 3 ' Box X_desk&+Mx&+A&,Y_desk&+My&+B&,X_desk&+Mx&+W&+A&-1,Y_desk&+My&+H&+B&-1 Box Mx&+A&,My&+B&,Mx&+W&+A&-1,My&+H&+B&-1 @Lshowm Clr P& Gosub Defmouse(3) A!=True Do X2&=Mx& Y2&=My& ~@Graf_mkstate(Mx&,My&,Mk&,D&) Mx&=Max(Min(Mx&,X_desk&+W_desk&-A&-W&),X_desk&-A&) ' My&=Max(Min(My&,Y_desk&+H_desk&-Ob_h(Adr%(16),Dk_bar&)-B&-H&),Y_desk&-B&) My&=Max(Min(My&,Y_desk&+H_desk&-B&-H&),Y_desk&-B&) ' If Mx&<>X2& Or My&<>Y2& N&=Objc_find(Adr%(16),0,7,Mx&,My&) If N&=0 A!=False Endif @Lhidem ' Box X_desk&+X2&+A&,Y_desk&+Y2&+B&,X_desk&+X2&+W&+A&-1,Y_desk&+Y2&+H&+B&-1 Box X2&+A&,Y2&+B&,X2&+W&+A&-1,Y2&+H&+B&-1 ' If N&=>0 And N&<>O& And N&<>P& If N&=>0 And N&<>P& Select Ob_type(Adr%(16),N&) Case 31,33 Default Clr N& Endselect ' If P&>0 ' Ob_state(Adr%(16),P&)=Bclr(Ob_state(Adr%(16),P&),0) Desel(16,P&) Gosub Drobj(P&) ' ~Objc_draw(Adr%(16),0,7,X_desk&+Ob_x(Adr%(16),P&),Y_desk&+Ob_y(Adr%(16),P&),Ob_w(Adr%(16),P&),Ob_h(Adr%(16),P&)) Endif P&=N& If P&>0 Ob_state(Adr%(16),P&)=Bset(Ob_state(Adr%(16),P&),0) Gosub Drobj(P&) Endif Endif ' Box X_desk&+Mx&+A&,Y_desk&+My&+B&,X_desk&+Mx&+W&+A&-1,Y_desk&+My&+H&+B&-1 Box Mx&+A&,My&+B&,Mx&+W&+A&-1,My&+H&+B&-1 @Lshowm Endif ' Loop until Mk&<>1 @Lhidem Box Mx&+A&,My&+B&,Mx&+W&+A&-1,My&+H&+B&-1 @Lshowm Graphmode 1 Defline 1 Gosub Defmouse(0) If Mk&<>0 Clr P& Mx&=Ob_x(Adr%(16),O&)-A&+X_desk& My&=Ob_y(Adr%(16),O&)-B&+Y_desk& Endif ' If And(D&,&X11)=0 If Mod(Mx&+A&,8)<>0 Mx&=((Mx&+A&)\8-(Mod(Mx&+A&,8)>3))*8-A& Endif If Mod(My&+B&,8)<>0 My&=((My&+B&)\8-(Mod(My&+B&,8)>3))*$ And And And And Eqv Xor -B& Endif Endif ' If A! ! ne rien faire Clr P& Endif ' If P&=0 ! d‚placement.. ou drag 'n drop/VA_PROTOCOL N&=Wind_find(Mx&,My&) If N&<=0 Ob_flags(Adr%(16),O&)=Bset(Ob_flags(Adr%(16),O&),7) ! hidetree Gosub Drobj(O&) Ob_flags(Adr%(16),O&)=Bclr(Ob_flags(Adr%(16),O&),7) ' Ob_x(Adr%(16),O&)=Mx&+A&-X_desk& Ob_y(Adr%(16),O&)=My&+B&-Y_desk& Gosub Drobj(O&) ' Gosub Defmouse(0) ' Else ! Drag & Dop / VA_PROTOCOL ' Note: on peut s'envoyer un drag&drop!! ' Clr E$ Select O& Case Dk_em& Select @Free_pop(Mx&,My&,"[Format ascii|D‚couper image|Format vid‚otex]") ' Select @Form_alert(1,"[2][Format: ][ Ascii | Image | Vid‚otex ]") Case 1 Gosub Emcut(0) Gosub Saveclp E$=Scrap$+"SCRAP.TXT" Case 2 Gosub Imcut(True) E$=Scrap$+"SCRAP.BLK" Case 3 ' binair$=@Miniblock$(0,1,Vmax_x&+1,Vmax_y&) Clearbin Gosub Copblk(@Miniblock$(0,1,Vmax_x&+1,Vmax_y&)) Gosub Saveclp2 E$=Scrap$+"SCRAP.VDT" Endselect Case Dk_fil& Case Dk_prn& Case Dk_clp& E$=Scrap$+"SCRAP.1ST" Case Dk_mod& Case Dk_cor& Endselect If Len(E$)>0 E$=E$+Chr$(0) ' print "dragged" ~Wind_get(N&,20,X2&,Y2&,Y2&,Y2&) If X2&=>0 Gosub Xxappl(X2&,&H4711,Word(Swap(V:E$)),Word(V:E$),0,0,0) ! oqp! Endif Endif ' Endif Endif ' If P&>0 ! drag interne ' Gosub Infreg Keepbin(True) ! 'sauver' buffer! ~@Tstblk ' Wmove(Ob_x(Adr%(16),O&),Ob_y(Adr%(16),O&),Ob_w(Adr%(16),O&),Ob_h(Adr%(16),O&),Ob_x(Adr%(16),P&),Ob_y(Adr%(16),P&),Ob_w(Adr%(16),P&),Ob_h(Adr%(16),P&)) ' Select O& ' Case Dk_em& If @Tstblk Select P& Case Dk_prn& If @Free_pop(Mx&,My&,"[Imprimer page]")=1 ' If @Form_alert(1,"[2][Imprimer page?][Confirmer| Annuler ]")=1 Gosub Emcut(0) Gosub Printbnr Endif Case Dk_cor& ' ~@Emulek(177,0,True,0) Select @Free_pop(Mx&,My&,"[Effacer ‚cran|R‚initialiser]") Case 1 @Vcls(True) ! pas besoin de reset donc.. Case 2 Gosub Defmouse(2) Gosub Emulm(0) Gosub Emul_uninit Gosub Emul_init ' ~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) Endselect Case Dk_clp& Gosub Emcut(0) Gosub Saveclp ' binair$=@Miniblock$(0,1,Vmax_x&+1,Vmax_y&) Clearbin Gosub Copblk(@Miniblock$(0,1,Vmax_x&+1,Vmax_y&)) Gosub Saveclp2 Case Dk_fil& Select @Free_pop(Mx&,My&,"[Format ascii|D‚couper image|Format vid‚otex]") ' Select @Form_alert(1,"[2][Format: ][ Ascii | Image | Vid‚otex ]") Case 1 Gosub Emcut(0) Gosub Save.vdt(1) Case 2 Gosub Imcut(False) Case 3 ' binair$=@Miniblock$(0,1,Vmax_x&+1,Vmax_y&) Clearbin Gosub Copblk(@Miniblock$(0,1,Vmax_x&+1,Vmax_y&)) Gosub Save.vdt(0) Endselect Case Dk_em& Default ~@Form_alert(1,"[1][Op‚ration impossible!][ Annuler ]") Endselect Endif ' Case Dk_fil& If @Tstblk Select P& Case Dk_cor& ~@Selectk(195,0,195) Case Dk_prn& ' Clr binair$ Clearbin Gosub Load.vdt(False) ' If Len(binair$)>0 If Binp%>0 Gosub Printbnr Endif Case Dk_em& Keepbin(False) ! 'restaurer' buffer! Gosub Load.vdt(True) ' If Len(binair$)>0 If Binp%>0 ~@Selectk(5,0,5) Endif Case Dk_fil& Gosub Copie Case Dk_mod& Clearbin Gosub Load.vdt(False) If Binp%>0 Gosub Envslow Endif Case Dk_clp& Gosub Clp_lire(0) Default ~@Form_alert(1,"[1][Op‚ration impossible!][ Annuler ]") Endselect Endif Case Dk_prn& Select P& Case Dk_cor& ' If @Form_alert(1,"[2][Initialiser imprimante?][Confirmer| Annuler ]")=1 Select @Free_pop(Mx&,My&,"[Initialiser imprimante||Saut de page|Saut de ligne]") Case 1 @Lprint(Chr$(27)+"@") Case 2 @Lprint(Chr$(12)) Case 3 @Lprint(Chr$(13)+Chr$(10)) Endselect Case Dk_prn& Default ~@Form_alert(1,"[1][Op‚ration impossible!][ Annuler ]") Endselect Case Dk_clp& If @Tstblk Select P& Case Dk_cor& If @Exist(Scrap$+"SCRAP.*") If @Free_pop(Mx&,My&,"[Effacer presse-papier]")=1 ' If @Form_alert(1,"[2][Effacer presse-papier?][Confirmer| Annuler ]")=1 Gosub Delclp Endif Else ~@Form_alert(1,"[1][Presse-papier vide!][ Annuler ]") Endif Case Dk_prn& $S& Select (-@Exist(Scrap$+"SCRAP.TXT"))+Shl(-@Exist(Scrap$+"SCRAP.1ST"),1) Case &X11 Select @Free_pop(Mx&,My&,"[Imprimer dernier (TXT)|Imprimer tout (1ST)]") ' Select @Form_alert(1,"[2][Imprimer:|SCRAP.TXT|SCRAP.1ST][TXT|1ST|Annuler]") Case 1 File$(2)=Scrap$+"SCRAP.TXT" Case 2 File$(2)=Scrap$+"SCRAP.1ST" Default File$(2)="" Endselect Case &X1 ! txt File$(2)=Scrap$+"SCRAP.TXT" Case &X10 ! 1st File$(2)=Scrap$+"SCRAP.1ST" Case 0 File$(2)="" ~@Form_alert(1,"[1][Presse-papier vide!][ Annuler ]") Endselect ' If Len(File$(2))>0 If @Exist(File$(2)) ' Clr binair$ Clearbin Gosub Load.vdt(1) ' If Len(binair$)>0 If Binp%>0 Gosub Printbnr Endif Else ~@Form_alert(1,"[1][Erreur de lecture!][ Annuler ]") Endif Endif Case Dk_em& If @Exist(Scrap$+"SCRAP.VDT") ' Clr binair$ Clearbin File$(2)=Scrap$+"SCRAP.VDT" Gosub Load.vdt(1) ' If Len(binair$)>0 If Binp%>0 ~@Wind_open(4) @Top(4) ~@Selectk(5,0,5) Endif Else ~@Form_alert(1,"[1][Presse-papier vide!][ Annuler ]") Endif Case Dk_fil& If @Exist(Scrap$+"SCRAP.*") Gosub Copy_clip Else ~@Form_alert(1,"[1][Presse-papier vide!][ Annuler ]") Endif ' Case Dk_mod& If @Exist(Scrap$+"SCRAP.TXT") Clearbin File$(2)=Scrap$+"SCRAP.TXT" Gosub Load.vdt(1) If Binp%>0 Gosub Envslow Endif Else ~@Form_alert(1,"[1][Presse-papier vide!][ Annuler ]") Endif ' Case Dk_clp& Default ~@Form_alert(1,"[1][Op‚ration impossible!][ Annuler ]") Endselect Endif Case Dk_mod& Select P& Case Dk_fil& Gosub Recept ' Case Dk_em&,Dk_clp& ' Case Dk_prn& Case Dk_cor& Gosub Modcut ! couper la liaison Case Dk_mod& Default ~@Form_alert(1,"[1][Op‚ration impossible!][ Annuler ]") Endselect Case Dk_cor& Select P& Case Dk_cor& Default ~@Form_alert(1,"[1][Op‚ration impossible!][ Annuler ]") Endselect Endselect ' ' Ob_state(Adr%(16),O&)=Bclr(Ob_state(Adr%(16),O&),0) ' Ob_state(Adr%(16),P&)=Bclr(Ob_state(Adr%(16),P&),0) Desel(16,O&) Desel(16,P&) Gosub Drobj(O&) Gosub Drobj(P&) Endif ' Endif ! btst (ob_state) ' Else if Clic&=2 Gosub Undsk ! effacer s‚lection Ob_state(Adr%(16),O&)=Bset(Ob_state(Adr%(16),O&),0) Gosub Drobj(O&) ' Select O& Case Dk_em& If Not Wopen!(4) ~@Wind_open(4) @Top(4) Else Select @Free_pop(Mx&,My&,"[Options|Emulation]") Case 1 Set_opt Case 2 Set_eml Endselect Endif Case Dk_fil& Select @Free_pop(Mx&,My&,"[Charger bloc|Sauver bloc|Charger texte]") Case 1 @Load.vdt(True) Case 2 Gosub Save.vdt(0) Case 3 @Load.vdt(-2) Endselect Case Dk_prn& ~@Form_alert(1,"[1][Je ne puis d‚monter |l'imprimante!][ Annuler ]") Case Dk_clp& Gosub View_clip Case Dk_cor& ~@Form_alert(1,"[1][Je ne puis me permettre |d'ouvrir la corbeille!][ Annuler ]") Case Dk_mod& Select @Free_pop(Mx&,My&,"[R‚glages|Chaines||Options|Emulation|Photo]") Case 1 Gosub Set_rs Case 2 Gosub Set_mdm Case 3 Gosub Set_opt Case 4 Gosub Set_eml Case 5 Gosub Set_pho Endselect ' ~@Emulek(147,0,True,0) ! status Endselect ' ' Ob_state(Adr%(16),O&)=Bclr(Ob_state(Adr%(16),O&),0) Desel(16,O&) Gosub Drobj(O&) ' Endif ' Case 20,21 ! bureau If And(T&,&X11)=0 Gosub Undsk ! effacer s‚lection Endif ' ' 'Y&=Y_desk&+Ob_y(Adr%(16),Dk_bar&)+Ob_y(Adr%(16),Dk_f1&) ' If My&0 Ob_state(Adr%(16),O&)=Bset(Ob_state(Adr%(16),O&),0) Gosub Drobj(O&) ' Gosub W_rdexe N&=N&+186 If @Selectk(N&,0,N&)=0 If N&<>189 ~@Emulek(N&,0,False,0) Else @Selectmnu(N&) Endif Endif Gosub Caremouse ' Ob_state(Adr%(16),O&)=Bclr(Ob_state(Adr%(16),O&),0) Desel(16,O&) Gosub Drobj(O&) ' Endif ' Gosub Undsk ! effacer s‚lection ' ' Endif Endif ' Case 22 If Btst(Ob_flags(Adr%(16),O&),6) ! touchexit If And(T&,&X11)<>0 And Btst(Ob_flags(Adr%(16),O&),4) ~Objc_offset(Adr%(16),O&,X&,Y&) ' ~Graf_dragbox(Ob_w(Adr%(16),O&),Ob_h(Adr%(16),O&),X&,Y&,X_desk&,Y_desk&,W_desk&,H_desk&-Ob_h(Adr%(16),Dk_bar&),X2&,Y2&) ~Graf_dragbox(Ob_w(Adr%(16),O&),Ob_h(Adr%(16),O&),X&,Y&,X_desk&,Y_desk&,W_desk&,H_desk&,X2&,Y2&) ~Graf_mkstate(Mx&,My&,Mk&,D&) ! pour D& ' If And(D&,&X11)=0 If Mod(X2&,8)<>0 X2&=(X2&\8-(Mod(X2&,8)>3))*$ And And And And Eqv Xor Endif If Mod(Y2&,8)<>0 Y2&=(Y2&\8-(Mod(Y2&,8)>3))*8 Endif ' Endif ' Ob_x(Adr%(16),O&)=X2&-X_desk& Ob_y(Adr%(16),O&)=Y2&-Y_desk& ~Form_dial(3,0,0,0,0,X&-3,Y&-3,Ob_w(Adr%(16),O&)+6,Ob_h(Adr%(16),O&)+6) ~Form_dial(3,0,0,0,0,X2&-3,Y2&-3,Ob_w(Adr%(16),O&)+6,Ob_h(Adr%(16),O&)+6) ' ' Else if Clic&=2 Or And(T&,&X1100)<>0 ' Else if And(T&,&X1100)<>0 ' ' Else ' Else Select O& Case Dk_cf2& ! cnxf N&=3 Case Dk_so2& ! somm N&=199 Case Dk_an2& ! annul N&=225 Case Dk_re2& ! ret N&=200 Case Dk_rp2& ! rep N&=27 Case Dk_ap2& ! APPEL If Not Connect! N&=192 Endif Case Dk_gu2& ! guide N&=226 Case Dk_co2& ! corr N&=8 Case Dk_su2& ! suite N&=208 Case Dk_en2& ! envoi N&=13 ' Case Dk_rec2& N&=-1 Case Dk_arr2& N&=-2 Case Dk_ava2& N&=-3 Case Dk_pla2& N&=-4 Case Dk_pau2& N&=-5 Case Dk_sto2& N&=-6 ' Default N&=0 Endselect If N&>0 ~@Emulek(N&,0,False,0) Gosub W_rdexe Gosub Caremouse Ob_state(Adr%(36),O&)=Bclr(Ob_state(Adr%(36),O&),0) ~Form_dial(3,0,0,0,0,X&-2,Y&-2,W&+4,H&+4) ' Else if N&<0 Gosub Clip_off Gosub Magn(-N&) Endif Endif Endif ' Endselect Keepbin(False) ! 'sauver' buffer! ' Endif Gosub Caremouse ' Return ' Appel‚ lors d'un topped Procedure Zedesk Local Mx&,My&,Mk&,D& ' If Desk_act! ~Graf_mkstate(Mx&,My&,Mk&,D&) Desk_sel(Mx&,My&,Mk&,Clic&) Endif Return ' Cacher ou non certains objets Procedure Desk_hide ' Rflags(16,Dk_boxc&,7,Not Desk_m!) ' Rflags(16,Dk_bar&,7,Not Desk_f!) ' Rflags(16,Dk_bar2&,7,Not Desk_m!) ' Rflags(16,Dk_fil&,7,Not Desk_i!) Rflags(16,Dk_em&,7,Not Desk_i!) Rflags(16,Dk_mod&,7,Not Desk_i!) Rflags(16,Dk_prn&,7,Not Desk_i!) Rflags(16,Dk_clp&,7,Not Desk_i!) Rflags(16,Dk_cor&,7,Not Desk_i!) ' ' Rflags(16,Dk_cf&,7,Not Desk_c!) ' Rflags(16,Dk_so&,7,Not Desk_c!) ' Rflags(16,Dk_an&,7,Not Desk_c!) ' Rflags(16,Dk_re&,7,Not Desk_c!) ' Rflags(16,Dk_rp&,7,Not Desk_c!) ' Rflags(16,Dk_gu&,7,Not Desk_c!) ' Rflags(16,Dk_co&,7,Not Desk_c!) ' Rflags(16,Dk_su&,7,Not Desk_c!) ' Rflags(16,Dk_en&,7,Not Desk_c!) Return ' ' ' Procedure Drobj(O&) Local Rx&,Ry&,Rw&,Rh& Local X&,Y&,W&,H& Local I& ' If Desk_act! If Menu_adr%>0 Clr I& Else I&=Whandle&(Nbr_idxw&) Endif ' ~Objc_offset(Adr%(16),O&,X&,Y&) W&=Ob_w(Adr%(16),O&) H&=Ob_h(Adr%(16),O&) ~Wind_get(I&,11,Rx&,Ry&,Rw&,Rh&) While Rw&>0 If Rc_intersect(X&,Y&,W&,H&,Rx&,Ry&,Rw&,Rh&) ~Objc_draw(Adr%(16),0,7,Rx&,Ry&,Rw&,Rh&) Endif ~Wind_get(I&,12,Rx&,Ry&,Rw&,Rh&) Wend Endif ' Return Procedure Drobjc(O&) Local Rx&,Ry&,Rw&,Rh& Local X&,Y&,W&,H& Local I& ' If Wopen!(4) And Nice! ' Bien placer objet Ob_x(Adr%(36),0)=@Wxacoord(4,0) Ob_y(Adr%(36),0)=@Wyacoord(4,(Vmax_y&+1)*Eccsizey&+Emy&+4) ' I&=Whandle&(4) ' ~Objc_offset(Adr%(36),O&,X&,Y&) W&=Ob_w(Adr%(36),O&) H&=Ob_h(Adr%(36),O&) ~Wind_get(I&,11,Rx&,Ry&,Rw&,Rh&) While Rw&>0 If Rc_intersect(X&,Y&,W&,H&,Rx&,Ry&,Rw&,Rh&) ~Objc_draw(Adr%(36),0,7,Rx&,Ry&,Rw&,Rh&) Endif ~Wind_get(I&,12,Rx&,Ry&,Rw&,Rh&) Wend Endif ' Return Procedure Undsk Local N& ' N&=-1 Repeat Inc N& If Btst(Ob_state(Adr%(16),N&),0) Select Ob_type(Adr%(16),N&) Case 31,33 ' Ob_state(Adr%(16),N&)=Bclr(Ob_state(Adr%(16),N&),0) Desel(16,N&) Gosub Drobj(N&) Endselect Endif Until Btst(Ob_flags(Adr%(16),N&),5) ! lastob Return ' ' Magn‚to Procedure Magn(N&) Local A% ' If Magneto&<0 If Capt|=0 Clr Magneto& Endif Endif ' Select N& Case 1 ! rec Gosub Recept Mgstate(Magneto&) Case 2 ! arr If Magneto&=>1 And Magneto&<10 A%=Magpos% While A%>0 Exit if Byte{Binair%+A%}=12 Exit if Byte{Binair%+A%}=19 Dec A% Wend If A%>0 Dec A% While A%>0 Exit if Byte{Binair%+A%}=12 Exit if Byte{Binair%+A%}=19 Dec A% Wend Endif ' Magpos%=A%+1 ! sauter cls! Gosub Vcls(False) Endif Mgstate(Magneto&) Case 3 ! av If Magneto&=>1 And Magneto&<10 A%=Magpos% While A%<=Binp% Exit if Byte{Binair%+A%}=12 Exit if Byte{Binair%+A%}=19 Inc A% Wend If A%0 Gosub Save.vdt(0) Endif Else Mgstate(0) Endif Endselect Gosub Magc ' Return Procedure Mgstate(N&) Magneto&=N& ' Mgr(Dk_ava&,False) Mgr(Dk_arr&,False) Select Magneto& Case 0 Menu.info("Stop") Mgr(Dk_rec&,False) Mgr(Dk_pla&,False) Mgr(Dk_pau&,False) Mgr(Dk_sto&,False) Case 1,10 Menu.info("Play") Mgr(Dk_rec&,False) Mgr(Dk_pla&,True) Mgr(Dk_pau&,False) Mgr(Dk_sto&,False) Case 2,11,12 Menu.info("Pause (espace)") Mgr(Dk_rec&,False) Mgr(Dk_pla&,True) Mgr(Dk_pau&,True) Mgr(Dk_sto&,False) Case -1 Menu.info("Record") Mgr(Dk_rec&,True) Mgr(Dk_pla&,False) Mgr(Dk_pau&,False) Mgr(Dk_sto&,False) Case -2 Menu.info("Pause record") Mgr(Dk_rec&,True) Mgr(Dk_pla&,False) Mgr(Dk_pau&,True) Mgr(Dk_sto&,False) ' Case 100 ! error/wait Menu.info("Attente pause (espace)") Mgr(Dk_rec&,True) ' Mgr(Dk_pla&,True) Mgr(Dk_pau&,True) Mgr(Dk_ava&,True) Endselect ' Return Procedure Mgr(N&,A!) If N&>0 If Btst(Ob_state(Adr%(36),N&),0)<>A! ' Ob_state(Adr%(16),N&-Dk_cf&+Dk_cf2&)=Bchg(Ob_state(Adr%(16),N&-Dk_cf&+Dk_cf2&),0) Ob_state(Adr%(36),N&)=Bchg(Ob_state(Adr%(36),N&),0) ' If Desk_m! Gosub Drobj(N&-Dk_cf&+Dk_cf2&) Endif Gosub Drobjc(N&) ' Endif Endif ' ' Gosub W_rdexe Return Procedure Magc Local A$ ' ' print At(1,1);Binair%, If Binair%>0 If Magneto&>0 If Magpos%<=0 A$=@Led$("0000000") Else A$=@Led$(Str$(Magpos%,7)) Endif Else if Magneto&<0 ' A$=@Led$(Str$(Len(binair$),7)) A$=@Led$(Str$(Binp%,7)) Else A$="STOP" Endif Else A$="*VIDE*" Endif If Char{{Ob_spec(Adr%(36),Dk_txt&)}}<>A$ Char{{Ob_spec(Adr%(36),Dk_txt&)}}=A$ Char{{Ob_spec(Adr%(16),Dk_txt2&)}}=A$ Gosub Drobjc(Dk_txt&) If Desk_m! Gosub Drobj(Dk_txt2&) Endif Endif ' Return Function Led$(A$) Local A& ' For A&=1 To Len(A$) Select Mid$(A$,A&,1) Case "0" To "9" Mid$(A$,A&,1)=Chr$(Bclr(Asc(Mid$(A$,A&,1)),5)) Endselect Next A& Return A$ Endfunc Procedure Go_mag Local N&,X& Local A% Local A$ ' If Magneto&=1 Or Magneto&=2 Or Magneto&=0 A$=@Dinput$("Nø de page","",X&) If X&<>0 N&=Val(A$) If N&>0 And N&<=199 ' If Magneto&=0 Envoi(0) Endif ' If Magneto&=1 Or Magneto&=2 Gosub Defmouse(2) If N&>1 A%=1 For X&=1 To N&-1 Inc A% While A%<=Binp% Exit if Byte{Binair%+A%}=12 Exit if Byte{Binair%+A%}=19 Inc A% Wend Exit if A%=>Binp% Next X& Endif If A%0 ! sinon erreur! (timer=0 impossible) X&=(@Timsec(Gemdos(44))-@Timsec(T%)) ! h Y&=X&-(X&\3600)*3600 ! m Z&=Y&-(Y&\60)*60 ! s X&=X&\3600 Y&=Y&\60 Endif If X&=0 If Y&=0 E$=E$+Str$(Z&)+"''" Else E$=E$+Str$(Y&)+"'" E$=E$+@Nstr$(Z&)+"''" Endif Else E$=E$+Str$(X&)+"h" E$=E$+@Nstr$(Y&)+"'" E$=E$+@Nstr$(Z&)+"''" Endif Return E$ Endfunc ' xx:xx:xx Function Ftim$(T%) Local X&,Y&,Z& ' If T%<>0 X&=(@Timsec(Gemdos(44))-@Timsec(T%)) ! h Y&=X&-(X&\3600)*3600 ! m Z&=Y&-(Y&\60)*60 ! s X&=X&\3600 Y&=Y&\60 Endif ' Return @Nstr$(X&)+":"+@Nstr$(Y&)+":"+@Nstr$(Z&) Endfunc ' ' Valeur normalis‚e, n octets Function Valnorm(Adr%) Local Val# Local L&,A&,N&,P&,B& ' ' Type <..> Clr Val# ' L&=Byte{Adr%+1} ! len ' ' Traiter les octets (septets) Clr P& ! 2^0 au d‚but N&=5 Clr A& B&=Byte{Adr%+2} If Btst(Byte{Adr%+2},6) B&=(Not Bchg(B&,5)) Endif While L&>0 Repeat ' Compl‚mane … 2 si .. If Btst(B&,N&) Val#=Val#+2^(-P&) Endif Inc P& ! plus un Dec N& Until N&<0 N&=6 ! 1..7 Inc A& ! 1 octet de plus Dec L& ! un de moins ' B&=Byte{Adr%+2+A&} If Btst(Byte{Adr%+2},6) B&=(Not B&)+1 ! compl‚mant … 2 Endif ' Wend ' If Btst(Byte{Adr%+2},6) Val#=-Val# Endif ' Return Val# Endfunc ' ' Valeur integer, n octets Function Valint(Adr%) $F% Local Val% Local L&,A&,N&,P& ' ' Type <..> Clr Val% ' L&=Byte{Adr%+1} ! len ' P&=6+(L&-1)*7-1 ! 1..6 1..7 1..7 .. nombre de bits-1 ' ' Traiter les octets (septets) N&=5 Clr A& While L&>0 Repeat If Btst(Byte{Adr%+2+A&},N&) Val%=Val%+Bset(0,P&) Endif Dec P& Dec N& Until N&<0 N&=6 ! 1..7 Inc A& ! 1 octet de plus Dec L& ! un de moins Wend ' If Btst(Byte{Adr%+2},6) Val%=(Not Val%)-1 Endif Return Val% Endfunc ' Procedure Openlog Local A$ Local Adr% ' Adr%=Fgetdta() A&=Scrp_read(Scrap$) If A&<>1 Or Len(Scrap$)<=0 If Drive&<=1 ! <=A,B Scrap$=Chr$(Drive&+65)+":\CLIPBRD" Else ! C,D,E.. Scrap$="C:\CLIPBRD" Endif If Fsfirst(Scrap$,&H10)=-33 Fmshow("Cr‚ation du presse papier") A$=Scrap$+Chr$(0) ~Gemdos(57,L:V:A$) Fmhide Endif ' If Fsfirst(Scrap$,&H10)=0 Scrap$=Scrap$+"\" Void Scrp_write(Scrap$) ! nouveau clipbrd! Else Clr Scrap$ Endif ' ' ' Scrap$=@Fsel$("\*.*","*.*","Localiser \CLIPBRD") ' If Rinstr(Scrap$,".")>0 ' Scrap$=Left$(Scrap$,Rinstr(Scrap$,".")-1) ' Void Scrp_write(Scrap$) ' Else ' Scrap$="" ' Endif Endif ' ' ' If Fsfirst(Set_path$+"SYSTEME",&H10)=-33 ' A$=Set_path$+"SYSTEME"+Chr$(0) ' ~Gemdos(57,L:V:A$) ' Endif Logh&=-1 ' If Fsfirst(Set_path$+"SYSTEME\MACROS",&H10)=-33 ' A$=Set_path$+"SYSTEME\MACROS"+Chr$(0) ' ~Gemdos(57,L:V:A$) ' Endif If Fsfirst(Lpath$,&H10)=-33 A$=Left$(Lpath$,Len(Lpath$)-1)+Chr$(0) ~Gemdos(57,L:V:A$) Endif ' If Log! If @Exist(Lpath$+"SWIFTELP.LOG") Logh&=@Fopen(Lpath$+"SWIFTELP.LOG",2) If Logh&=>0 ~@Fendseek(Logh&,0) Endif Else Fmshow("Cr‚ation du fichier LOG") Logh&=@Fcreate(Lpath$+"SWIFTELP.LOG",0) Fmhide Endif Endif ' Tarif$=@Finput$("TARIFS.SET") ' ' A$=@Finput$("TARIFS.SET") ' Clr Tarif$ ' While Len(A$)>0 ' Tarif$=Tarif$+@Flin$(A$)+Mki$(&HD0A) ' Wend ' Redcnx%=100 ! aucune reduction Clr Unitcnx& Clr Acccnx& A$=Tarif$ While Len(A$)>0 B$=Upper$(Trim$(@Ntrim$(@Flin$(A$)))) N&=Instr(B$," ") If N&>0 If Left$(B$,5)="UNIT " ! UNIT 74 -> unit‚s de 74c Unitcnx&=Val(@Xtrim$(Mid$(B$,6))) Else if Left$(B$,7)="ACCESS " ! ACCESS 12 -> 12c pour FT en prime! Acccnx&=Val(@Xtrim$(Mid$(B$,8))) Else Clr N& Endif Endif Wend Unitcnx&=Max(Unitcnx&,1) Pal0cnx&=-1 Pal1cnx&=-1 Clr Red0cnx!,Red1cnx! Accpal!=False ' ' If Fsfirst(Fpath$,&H10)=-33 A$=Left$(Fpath$,Len(Fpath$)-1)+Chr$(0) ~Gemdos(57,L:V:A$) Endif ' Fichier "ajout" If @Exist(Fpath$+"FACTURE.LOG") Logt&=@Fopen(Fpath$+"FACTURE.LOG",2) If Logt&=>0 Facture$=@Fread$(Logt&,Long{Adr%+26}) ~@Fendseek(Logt&,0) Endif Else Logt&=@Fcreate(Fpath$+"FACTURE.LOG",0) Clr Facture$ Endif Gosub Facinit ' Return Procedure Closelog If Logh&=>0 ' Fmshow("Fermeture du fichier LOG") Gosub Defmouse(2) ~@Fclose(Logh&) Gosub Defmouse(0) Logh&=-1 ' Fmhide Endif If Logt&=>0 Gosub Defmouse(2) ~@Fclose(Logt&) Gosub Defmouse(0) Logt&=-1 Endif Return ' Procedure Outlog(E$) Local A$ ' If Logh&=>0 And Log! If Left$(E$,1)="*" E$=Mid$(E$,2) If Left$(E$,1)="*" E$=Mid$(E$,2) E$=" "+E$+Cr$+Time$+" " Else E$=Cr$+" "+E$ Endif Else E$=Time$+" "+E$ Endif ~@Fwrite(Logh&,E$+Mki$(&HD0A)) If Dim?(Wopen!()) If (Not Accessoire!) And Wopen!(1) Comp.info("",E$) Endif Endif Endif Return Procedure Outcom(E$) Local A& ' If Logt&=>0 And Log! If Len(E$)>0 ! sinon simple v‚rif ~@Fwrite(Logt&,E$+Mki$(&HD0A)) A&=Instr(E$,"|") ! … ‚viter! While A&>0 E$=Left$(E$,A&-1)+Mid$(E$,A&+1) A&=Instr(E$,"|") Wend Facture$=Facture$+E$+"|" Endif ' If Len(Facture$)>8192 Facture$=Mid$(Facture$,Len(Facture$)-4096) A&=Instr(Facture$,"|") If A&>0 Facture$=Mid$(Facture$,A&+1) Else Clr Facture$ ! ?? Endif Endif ' ' Calcul du "nombre de jours" absolus (faux car mois de 31 jours, pas gˆnant..) ' A$=Mid$(Facture$,1,10) ' D%=Val(Mid$(A$,1,2))+Val(Mid$(A$,4,2))*31+Val(Mid$(A$,7,4))*12*31 ' A$=Date$ ' E%=Val(Mid$(A$,1,2))+Val(Mid$(A$,4,2))*31+Val(Mid$(A$,7,4))*12*31 ' ' Faire la somme? Gosub Chkcom ' Endif Return Procedure Chkcom Local A&,M& Local A$,B$ Local S# ' A&=Rinstr(Facture$,"|",Max(0,Len(Facture$)-1)) If A&>0 A$=Mid$(Facture$,A&+1) ! ligne.. ' On a chang‚ de mois!! (ou plus de place!!) If Mid$(A$,4,2)<>Mid$(Date$,4,2) Or Len(Facture$)>8192 M&=Val(Mid$(A$,4,2)) ' S#=@Tar_sum Clr Facture$ ' @Eminfo("-== Total pour le mois de "+@Moi$(M&)+" : "+Str$(S#)+" FF ==-") ' A$=String$(78,"-")+Mki$(&HD0A) A$=A$+"Total pour le mois de "+@Moi$(M&)+" : "+Str$(S#)+" FF"+Mki$(&HD0A) A$=A$+String$(78,"-")+Mki$(&HD0A)+Mki$(&HD0A) A$=A$+"Date Heure Appel Dur‚e Co–t"+Mki$(&HD0A) ' |23.12.1999 23:59:00 3623 France telecom 01:00:00 5.20 ' A$=A$+String$(78,"-")+Mki$(&HD0A) ' ~@Fwrite(Logt&,A$) Endif Endif Return Function Moi$(M&) If M&<=0 Or M&>12 M&=13 Endif Return Trim$(Mid$("janvier f‚vrier mars avril mai juin juillet ao–t septembre octobre novembre d‚cembre ",(M&-1)*10+1,10)) Endfunc ' Co–t actuel de la facture Function Tar_sum Local S# Local E$ ' E$=Facture$ Clr S# A&=Instr(E$,"|") While A&>0 A$=Left$(E$,A&-1) ! ligne 23/12/99 23:59:59 blablabla blabla 01:00:00 5.20 E$=Mid$(E$,A&+1) ' B$=@Lft$(A$) ! prix S#=S#+Val(B$) A&=Instr(E$,"|") Wend Return S# Endfunc Function Tar_sum2$ Local X&,Y&,Z& Local S% Local E$ ' E$=Facture$ Clr S% A&=Instr(E$,"|") While A&>0 A$=Left$(E$,A&-1) ! ligne 23/12/99 23:59:59 blablabla blabla 01:00:00 5.20 E$=Mid$(E$,A&+1) ' B$=@Lft$(A$) ! prix B$=@Lft$(A$) ! temps S%=S%+Val(Mid$(B$,1,2))*3600+Val(Mid$(B$,4,2))*60+Val(Mid$(B$,7,2)) A&=Instr(E$,"|") Wend Y&=S%-(S%\3600)*3600 ! m Z&=Y&-(Y&\60)*60 ! s X&=S%\3600 Y&=Y&\60 ' Return @Nstr$(X&)+":"+@Nstr$(Y&)+":"+@Nstr$(Z&) Endfunc ' ' ' ' Infos Procedure Info Local E$,A$ Local A& Local A! Local N& ' Defmouse 0 @Showm Gosub Set_col(False) ' Gosub Tstrg Exdo!=True Repeat A&=Byte(@Form_wdo(2,0)) Select A& Case Noreg& Clr A& If Len(Register$)>0 E$="Cette version de "+Name$+" est enregistr‚e sous le nom de "+Key$(0)+" .. Ne pas diffuser! " Else E$="Swiftel d‚mo .. "+"Swiftel est un ShareWare .. l'enregistrement vous permet d'utiliser ce logiciel dans sa version complŠte " Endif Infscroll(0,E$) Endselect Until A&<>0 ' Ob_state(Adr%(2),A&)=Bclr(Ob_state(Adr%(2),A&),0) Desel(2,A&) ~@Form_wdo(2,-3) ' Gosub Set_col(True) ' ' ~@Form_alert(1,"[3][SwifteL! "+Release$+"|Emulation: Sweetel2, ½Roche.X|Cette version sp‚ciale |de Sweetel II est limit‚e … |l'‚mulateur. >Freeware<][Confirmer]") If Accessoire! Menu_acse Gosub Rdw_all(1) ' Else ' ~Form_alert(1,"[3][SwifteL! peut aussi |fonctionner en accessoire!][ Not‚ ]") Endif Return Procedure Infscroll(M&,E$) Local A&,N& Local A$ ' A$=Char{{Ob_spec(Adr%(2),Noreg&)}} E$=Space$(38)+E$ N&=Len(E$) E$=E$+E$ @Hidem Do Char{{Ob_spec(Adr%(2),Noreg&)}}=Mid$(E$,A&,38) ~Objc_draw(Adr%(2),Noreg&,7,Rx&(2),Ry&(2),Rw&(2),Rh&(2)) Inc A& If A&>N& If M&=1 Exit if True Else A&=1 Endif Endif If M&=0 Exit if @Mousek<>0 ' Pause 4 Vsync Vsync Vsync Vsync Vsync Vsync Else ' Pause 3 Vsync Vsync Vsync Vsync Endif Loop @Showm Char{{Ob_spec(Adr%(2),Noreg&)}}=A$ ~Objc_draw(Adr%(2),Noreg&,7,Rx&(2),Ry&(2),Rw&(2),Rh&(2)) ' Return Procedure Infmem Local A& Local T% ' ' Malloc$=Malloc$+Mkl$(Adr%)+Mkl$(M%) Clr T% A&=1 While A&0 Char{{Ob_spec(Adr%(2),Noreg&)}}=Left$("("+Key$(0)+")",38) Else Char{{Ob_spec(Adr%(2),Noreg&)}}="VERSION NON ENREGISTREE" Endif Return ' ' Function Winds_fields $F% Local A% ' ' ..Remplissage des tableaux, ' deja dimensionnes par Winds_init Wset_start_x(-1,0) ! Incr‚mentation nulle Wset_start_y(-1,0) ! Wset_flags(-1,&X100111111111111) ! Tous les attributs Wset_flags(Wdial&,&X100000000001011) ' Wset_flags(Nombre_w&-1,&X0) Wset_x(Nombre_w&-1,X_desk&) Wset_y(Nombre_w&-1,Y_desk&) Wset_w(Nombre_w&-1,W_desk&) Wset_h(Nombre_w&-1,H_desk&) ' Gosub Field_max ' .. Titre de fenˆtre ~@Titlew(1,"Informations "+Name$) ~@Titlew(2,"Fenˆtre d'image") ~@Titlew(3,"Fenˆtre de texte") ~@Titlew(4,Name$+" ~ Vid‚otex") ' ~@Infow(1,"Clic droit pour obtenir le panneau d'options") ~@Infow(2,"Contenu du presse-papier:") ~@Infow(3,"Contenu du presse-papier:") ~@Infow(4,"Emulation active-touches: clic droit") ' ~@Infow(Wdial&,"") ' Wset_x(Wdial&,X_desk&) Wset_y(Wdial&,Y_desk&+2) Wset_w(Wdial&,Ob_w(Adr%(Wd_id&),0)) ! Largeurs et Wset_h(Wdial&,Ob_h(Adr%(Wd_id&),0)) ! hauteurs actuels ' Wset_x(1,X_desk&) Wset_y(1,Max(Y_desk&,16)+(H_desk&\3)*2-(H_desk&\5)) Wset_w(1,W_desk&\2+W_desk&\4) ! hauteurs actuels Wset_h(1,(H_desk&\3)+(H_desk&\14)) ! Largeurs et ' Wset_x(4,X_desk&) Wset_y(4,Max(Y_desk&,12)) Wset_w(4,W_desk&-(W_desk&\64)-8) ! Largeurs et Wset_h(4,H_desk&-(H_desk&\64)-16) ! hauteurs actuels ' Wset_x(3,X_desk&+16) Wset_y(3,Max(Y_desk&,12)+8) Wset_w(3,W_desk&-(W_desk&\64)-8) ! Largeurs et Wset_h(3,H_desk&-(H_desk&\64)-16) ! hauteurs actuels ' Wset_x(2,X_desk&) Wset_y(2,Max(Y_desk&,12)) Wset_w(2,W_desk&-(W_desk&\64)-8) ! Largeurs et Wset_h(2,H_desk&-(H_desk&\64)-16) ! hauteurs actuels Wmax_on(2) ' Wset_x(1,X_desk&+16) Wset_y(1,H_desk&+Y_desk&-200) Wset_w(1,400) Wset_h(1,200) ' Wset_x(3,X_desk&+8) Wset_y(3,Y_desk&+4) Wset_w(3,W_desk&-16) Wset_h(3,H_desk&-8) ' Wset_x(4,64) Wset_y(4,24) Wset_w(4,W_desk&-128) Wset_h(4,H_desk&-32) ' If Len(Lcomm$)>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+8,4))*(Work_out(0)+1))\10000) Wset_h(A%,(Cvl(Mid$(Lcomm$,A%*36+1+12,4))*(Work_out(1)+1))\10000) ' ' Trop loin! If W_ex&(A%)=>X_desk&+W_desk&-16 Or W_ey&(A%)=>Y_desk&+H_desk&-8 W_ex&(A%)=X_desk&+16*A% W_ey&(A%)=Y_desk&+8*A% W_ew&(A%)=Max(320,Min(W_ew&(A%),W_desk&-16)) W_eh&(A%)=Max(120,Min(W_eh&(A%),H_desk&-8)) W_fx&(A%)=X_desk& W_fy&(A%)=Y_desk& W_fw&(A%)=W_desk&-16 W_fh&(A%)=H_desk&-8 Endif W_ew&(A%)=Max(160,Min(W_ew&(A%),W_desk&-16)) W_eh&(A%)=Max(60,Min(W_eh&(A%),H_desk&-8)) ' ' W_fx&(A%)=(Cvl(Mid$(Lcomm$,A%*36+1+16,4))*(Work_out(0)+1))\10000 ' W_fy&(A%)=Max(Y_desk&,(Cvl(Mid$(Lcomm$,A%*36+1+20,4))*(Work_out(1)+1))\10000) ' W_fw&(A%)=(Cvl(Mid$(Lcomm$,A%*36+1+24,4))*(Work_out(0)+1))\10000 ' W_fh&(A%)=(Cvl(Mid$(Lcomm$,A%*36+1+28,4))*(Work_out(1)+1))\10000 ' ' If Word(Cvi(Mid$(Lcomm$,A%*36+1+32,2)))=True ! ouverte? ' ~@Wind_create(A%) ! alors ouvrir! AGHHHHHHHHHHHHHH ???!!! ' 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 ' Wset_max_w(1,Max(W_desk&,100*Ccsizex&)) Wset_max_h(1,40*Ccsizey&) ! Wmax_on(1) ! pas de limites ' Wset_max_w(3,W_desk&) Wset_max_h(3,H_desk&) Wmax_off(3) ! limites ' Wset_max_w(4,Eccsizex&*(Vmax_x&+1)+4+Emx&) ! ‚mulat If Nice! Wset_max_h(4,Eccsizey&*(Vmax_y&+1)+4+Emy&+Emy2&) ! Else Wset_max_h(4,Eccsizey&*(Vmax_y&+8)+4+Emy&+Emy2&) ! Endif Wmax_off(4) ! limites ' Wset_max_w(Wdial&,W_desk&) Wset_max_h(Wdial&,H_desk&) ' Gosub Nice4 ' 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 1 @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 Pbox X&,Y&,X&+W&-1,Y&+H&-1 Endselect Gosub Deffill(Colg&,1,1) Gosub Deftext(Col1&,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 1 Draw_m(X&,Y&,W&,H&) Case 2 Draw_im(X&,Y&,W&,H&) Case 3 Draw_cl(X&,Y&,W&,H&) Case 4 ! emul ' @Xgbox(@Wxacoord(4,0),@Wyacoord(4,0),@Wxacoord(4,W_ew&(4)+W_desk&),@Wyacoord(4,W_eh&(4)+H_desk&)) ' @Xgbox(@Wxacoord(4,Emx&),@Wyacoord(4,Emy&),@Wxacoord(4,Emx&+(Vmax_x&+1)*Eccsizex&),@Wyacoord(4,(Vmax_y&+1)*Eccsizey&+Emy&)) ' Draw_e(X&,Y&,W&,H&) Case Wdial& Draw_wd(X&,Y&,W&,H&) Case Nbr_idxw& Draw_b(X&,Y&,W&,H&) ' Endselect $S% ' Else ' Gosub Deffill(Colg&,2,10) 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_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) Gosub Sweety_text Deffill 4 Pbox @Wxacoord(1,0),@Wyacoord(1,0),@Wxacoord(1,W_iw&(1)),@Wyacoord(1,Ccsizey&\2) Deffill 1 ' @Wtext(1,16,Ccsizey&,"Messages:") ' @Wtext(1,8+Ccsizex&*40,Ccsizey&,"De:") ' @Wtext(1,8+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%+2)*Ccsizey&,Mid$(Compinf$(A%),2)) Gosub Deftextattrb(&H0) Default @Wtext(1,10,(A%+2)*Ccsizey&,Compinf$(A%)) Endselect $S% Gosub Graphmode(2) Next A% ' Return Procedure Draw_e(X&,Y&,W&,H&) ! emulat ' Gosub Deffill(0,0,0) Pbox X&,Y&,X&+W&-1,Y&+H&-1 @Xgbox(@Wxacoord(4,Emx&),@Wyacoord(4,Emy&),@Wxacoord(4,Emx&+(Vmax_x&+1)*Eccsizex&),@Wyacoord(4,(Vmax_y&+1)*Eccsizey&+Emy&)) Gosub Deffill(Fcol&(0),Fstyl|(0),Findex|(0)) Pbox @Wxacoord(4,Emx&),@Wyacoord(4,Emy&),@Wxacoord(4,Emx&+(Vmax_x&+1)*Eccsizex&),@Wyacoord(4,(Vmax_y&+1)*Eccsizey&+Emy&) ' If Nice! Ob_x(Adr%(36),0)=@Wxacoord(4,0) Ob_y(Adr%(36),0)=@Wyacoord(4,(Vmax_y&+1)*Eccsizey&+Emy&+4) ~Objc_draw(Adr%(36),0,7,X&,Y&,W&,H&) Endif ' ' Gosub Sweety_text Gosub Eminfo("") ' If W&>0 And H&>0 If Rc_intersect(@Wxacoord(4,Emx&),@Wyacoord(4,Emy&),(Vmax_x&+1)*Eccsizex&,(Vmax_y&+1)*Eccsizey&,X&,Y&,W&,H&) @Clip(X&,Y&,W&,H&) ' 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&) ' Endif Endif ' Return Procedure Draw_b(X&,Y&,W&,H&) ~Objc_draw(Adr%(16),0,7,X&,Y&,W&,H&) Return Procedure Draw_cl(X&,Y&,W&,H&) Local N%,L&,C&,A&,B& Local E$ ' Gosub Deffillcol(0) Pbox X&,Y&,X&+W&-1,Y&+H&-1 Gosub Sweety_text ' If Clp%>0 A&=Ccsizex& B&=Ccsizey& ' If Clpline&>0 N&=Max(0,(@Wyrcoord(3,Y&)-B&)\Ccsizey&-2) For L&=N& To Min(N&+H&\Ccsizey&+3,Clpline&-1) Clr E$ E$=Char{Clp%+Long{Clpref%+L&*4}} C&=Instr(E$,Chr$(9)) While C&>0 E$=Left$(E$,C&-1)+Space$(8-Mod(C&-1,8))+Mid$(E$,C&+1) C&=Instr(E$,Chr$(9)) Wend Text @Wxacoord(3,A&),@Wyacoord(3,B&+L&*Ccsizey&),E$ Next L& Endif Endif ' Return Procedure Draw_im(X&,Y&,W&,H&) Gosub Deffillcol(0) Pbox X&,Y&,X&+W&-1,Y&+H&-1 ' If Iclp%>0 And Imf%>0 ' W&=Min(W&,Word{Imf%+4}-@Wxrcoord(2,X&)) H&=Min(H&,Word{Imf%+6}-@Wyrcoord(2,Y&)) ' If W&>0 And H&>0 G_s%(0)=Long{Imf%} ! placer adresse G_s%(1)=Word{Imf%+4} G_s%(2)=Word{Imf%+6} G_s%(3)=Word{Imf%+8} G_s%(4)=0 G_s%(5)=Plans& ' R_d%(0)=@Wxrcoord(2,X&) R_d%(1)=@Wyrcoord(2,Y&) R_d%(2)=R_d%(0)+W&-1 R_d%(3)=R_d%(1)+H&-1 R_d%(4)=X& R_d%(5)=Y& R_d%(6)=X&+W&-1 R_d%(7)=Y&+H&-1 R_d%(8)=3 ' Bitblt G_s%(),G_screen%(),R_d%() ! Vdi Raster Copy ; Opaque ' Endif Endif Return ' ' proc redraw dialer Procedure Draw_wd(X&,Y&,W&,H&) Local N& Local X2&,Y2& Local A& ' A!=Btst(Ob_state(Adr%(Wd_id&),0),4) Ob_state(Adr%(Wd_id&),0)=Bclr(Ob_state(Adr%(Wd_id&),0),4) ' A&=Byte(Swap(Ob_spec(Adr%(Wd_id&),0))) ! ‚paisseur Ob_spec(Adr%(Wd_id&),0)=And(Ob_spec(Adr%(Wd_id&),0),&HFF00FFFF) ' 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&) N&=-1 Repeat Inc N& ' ~Objc_offset(Adr%(Wd_id&),N&,X2&,Y2&) If X2&<=X&+W&-1 And Y2&<=Y&+H&-1 If X2&+Ob_w(Adr%(Wd_id&),N&)-1=>X& And Y2&+Ob_h(Adr%(Wd_id&),N&)-1=>Y& ' ~Objc_draw(Adr%(Wd_id&),0,7,X&,Y&,W&,H&) If (Not Btst(Ob_state(Adr%(Wd_id&),N&),1)) ~Objc_draw(Adr%(Wd_id&),N&,0,X&,Y&,W&,H&) Else If Ob_state(Adr%(Wd_id&),N&)=&X11 ' Ob_state(Adr%(Wd_id&),N&)=&X11 ~Objc_draw(Adr%(Wd_id&),N&,0,X&,Y&,W&,H&) ' Ob_state(Adr%(Wd_id&),N&)=&X11 Else Ob_state(Adr%(Wd_id&),N&)=&X1 ~Objc_draw(Adr%(Wd_id&),N&,0,X&,Y&,W&,H&) Ob_state(Adr%(Wd_id&),N&)=&X10 Endif Endif Endif Endif Until Btst(Ob_flags(Adr%(Wd_id&),N&),5) ! lastob Ob_spec(Adr%(Wd_id&),0)=Or(And(Ob_spec(Adr%(Wd_id&),0),&HFF00FFFF),Swap(A&)) If A! Ob_state(Adr%(Wd_id&),0)=Bset(Ob_state(Adr%(Wd_id&),0),4) Endif ' Rx&(Wd_id&)=Ob_x(Adr%(Wd_id&),0) Ry&(Wd_id&)=Ob_y(Adr%(Wd_id&),0) Return ' ' Protection Function Crc81(E$) Local A& Local S& Clr S& For A&=1 To Len(E$) S&=Byte(A&+Len(E$)+S&+Asc(Mid$(E$,A&,1))) Next A& Return S& Endfunc ' ' Procedure Sm_draw(Index&,X&,Y&,W&,H&) ! smalled Gosub Deffillcol(0) 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 1 If Fre()<20000 Defmouse 2 Void Fre(0) Defmouse 0 If Fre()<20000 ~@Infow(Index&,"ProblŠmes de m‚moire!") Endif Else 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$))) ' If Not Mexe! ' Gosub Menu.info("Attente.. octets captur‚s: "+Str$(Binp%)) ' Endif ' Else if Capt|=2 ' ' Gosub Menu.info("Attente de fin de page.. octets captur‚s: "+Str$(Len(binair$))) ' If Not Mexe! ' Gosub Menu.info("Attente de fin de page.. octets captur‚s: "+Str$(Binp%)) ' Endif ' Else Menu_time!=True ' Endif Endif Case 4 ' Emstat If Inf4&>0 ~@Infow(Index&,"") Else ~@Infow(Index&," ") Endif Endselect $S% ' Return Procedure Rdw_all(Index&) If Index&=>0 If Wopen!(Index&) Gosub Rd_all(Index&,W_ix&(Index&),W_iy&(Index&),W_iw&(Index&),W_ih&(Index&)) Endif Endif Return ' Procedure Menu_open Local A& ' If Not Accessoire! If W_desk&>500 ! ‚cran trop petit! Menu_adr%=Adr%(43) Else Menu_adr%=Adr%(10) Endif ' Menu_id&=13 ' ~Menu_bar(Menu_adr%,1) Menu_create ' Gosub Menu_set ! checkings ' Endif ' Dim Menp$(3) Gosub Load_exe ' If Menu_adr%>0 Gosub Ref_exe Endif ' Return ' ' ' 1 Charger 1ST -1 React 0 Fich libre 10 Copie buffer VDT 2 Fichier XX Procedure Clp_lire(X&) Local Adr% Local N%,L&,N&,M&,P& Local File$ Local Fileh& ' If Imp(X&=-1,Wopen!(3)) If Clp%>0 ~@Mfree(Clp%) ~@Mfree(Clpref%) Clplen%=0 Endif ' Adr%=Fgetdta() If X&=0 File$=@Fsel$("\*.*","","Voir fichier") ' If Len(File$)>0 $S% Select Upper$(Right$(File$,4)) Case ".BLK" File$(4)=File$ Gosub Clp_img(2) ! image! Clr File$ Case ".VDT",".VID",".MIN" ! vid‚otex! File$(2)=File$ Gosub Load.vdt(1) If Binp%>0 Gosub Envoi(1) Endif Clr File$ Case ".IMG",".GIF",".TGA",".JPG",".PNT",".BMP",".IFF",".PCX",".PCD",".TIF",".TNY",".ART",".FTC",".PIC",".NEO",".DOO",".PNT",".MAC",".PAC",".XGA",".ESM",".GEM",".SEF",".PI1",".PI2",".PI3",".PC1",".PC2",".PC3" ~@Form_alert(1,"[1][Image non g‚r‚e!|Passez sous: |Piccolo ou D2M, BV4..][Confirmer]") Clr File$ Case ".PRG",".TOS",".TTP",".APP",".GTP",".RSC",".CNF",".DAT" ~@Form_alert(1,"[1][Fichier non visualisable!][Annuler]") Clr File$ Endselect $S& Endif ' Else if Abs(X&)=1 File$=Scrap$+"SCRAP.1ST"+Chr$(0) Else if Abs(X&)=2 File$=File$(3)+Chr$(0) Else File$="" Endif If X&=10 Clplen%=Binp%+1 Clp%=@Malloc(Clplen%) If Clp%>0 Bmove Binair%,Clp%,Binp% Byte{Clp%+Clplen%-1}=13 Else ~@Form_error(1,@Errf$(-39)) Endif Else If Len(File$)>0 If @Exist(File$) If Not Wopen!(3) ~@Wind_open(3) W_rdexe Endif ' Gosub Defmouse(2) Fileh&=@Fopen(File$,0) If @Tsterr(Fileh&) Clplen%=Long{Adr%+26}+1 Clp%=@Malloc(Clplen%) If Clp%>0 ~@Tsterr(@Fadrread(Fileh&,Clp%,Clplen%)) Byte{Clp%+Clplen%-1}=13 Else ~@Form_error(1,@Errf$(-39)) Endif ~@Tsterr(@Fclose(Fileh&)) Endif Endif Endif Endif Gosub Defmouse(0) ' If Clp%>0 P&=0 Do Gosub Defmouse(2) N%=0 L&=0 N&=0 M&=0 Do Select Byte{Clp%+N%} Case 0,10,13 Byte{Clp%+N%}=0 Select Byte{Clp%+N%+1} Case 0,10,13 Inc N% Byte{Clp%+N%}=0 Endselect M&=Max(M&,N&) Clr N& If P&=1 Long{Clpref%+(L&+1)*4}=N%+1 Endif Inc L& If L&>32000 N%=Clplen% Endif Case 9 N&=N&+(8-Mod(N&,8)) Default Inc N& If N&>512 M&=Max(M&,N&) Clr N& Byte{Clp%+N%}=0 If P&=1 Long{Clpref%+(L&+1)*4}=N%+1 Endif Inc L& Endif Endselect Inc N% Loop until N%=>Clplen% Clpline&=L& ' If P&=0 ! Fin 1Šre passe! Clpref%=@Malloc(4*(Clpline&+2)) If Clpref%>0 Long{Clpref%}=0 ! 1ere ligne commence en 0 Else ~Mfree(Clp%) ~Mfree(Clpref%) Clplen%=0 P&=1 ! exit Endif Endif ' Inc P& Loop until P&>1 Gosub Defmouse(0) ' Else Clplen%=0 Endif ' Start_x%(3)=0 Start_y%(3)=0 Wset_max_h(3,(Clpline&+2)*Ccsizey&) Wset_max_w(3,(M&+4)*Ccsizex&) If Wopen!(3) Gosub Wsetsl(3) Gosub Rdw_all(3) Endif Select Abs(X&) Case 0,2 ~@Infow(3,"Contenu du fichier: "+Left$(File$,Len(File$)-1)+" ("+Str$(Max(0,Clplen%-1))+"o)") Case 1 ~@Infow(3,"Contenu du presse-papier: SCRAP.1ST ("+Str$(Max(0,Clplen%-1))+"o)") Case 10 ~@Infow(3,"Copie du buffer: ("+Str$(Max(0,Clplen%-1))+"o)") Endselect ' Endif ' Return Function Clipkey(Key&,Shift&,Key2&) $F% Local A! Local L& Local E$,A$ ' A!=False Select Key& Case 10 A!=True If Len(Clp$)>0 If Left$(Clp$,1)=" " Mid$(Clp$,1,1)="*" Else Mid$(Clp$,1,1)=" " Endif Endif Case 13 If Len(Clp$)>1 A$=Clp$ L&=0 If Right$(A$,1)=Chr$(0) A$=Left$(A$,Len(A$)-1) If Len(A$)>2 L&=Max(0,Min(Cvi(Right$(A$,2)),Clpline&-2)) A$=Left$(A$,Len(A$)-2) Clp$=Left$(Clp$,Len(Clp$)-3) Else Clr Clp$ Endif Endif A!=(Left$(A$,1)="*") A$=Mid$(A$,2) If A! A$=Upper$(A$) Endif Gosub Defmouse(2) Repeat Clr E$ E$=Char{Clp%+Long{Clpref%+L&*4}} If A! E$=Upper$(E$) Endif If Instr(E$,A$)>0 Start_y%(3)=L&*Ccsizey& Wsetsl(3) Rdw_all(3) L&=-L&-2 Endif Exit if @Shiftbrk Inc L& Until L&>Clpline&-1 Or L&<0 Gosub Defmouse(0) If L&<0 L&=Abs(L&) ~@Infow(3,"Trouv‚ ligne "+Str$(L&)+" - Suivant: Return") If A! Clp$=Clp$+Mki$(L&)+Chr$(0) Else Clp$=Clp$+Mki$(L&)+Chr$(0) Endif Else ~@Infow(3,"Non trouv‚") Clr Clp$ Endif Else Clr Clp$ Endif ' A!=True Case 208 If Btst(Shift&,2) V_dec(3,Start_y%(3)+W_ih&(3)-Ccsizey&) ! d‚calage vertical Else V_dec(3,Start_y%(3)+Ccsizey&) ! d‚calage vertical Endif @Fdtest Case 200 If Btst(Shift&,2) V_dec(3,Start_y%(3)-W_ih&(3)+Ccsizey&) ! d‚calage vertical Else V_dec(3,Start_y%(3)-Ccsizey&) ! d‚calage vertical Endif @Fdtest Case 205 If Btst(Shift&,2) H_dec(3,Start_x%(3)+W_ew&(3)-Ccsizex&) ! d‚calage h Else H_dec(3,Start_x%(3)+Ccsizex&) ! d‚calage h Endif @Fdtest Case 203 If Btst(Shift&,2) H_dec(3,Start_x%(3)-W_ew&(3)+Ccsizex&) ! d‚calage h Else H_dec(3,Start_x%(3)-Ccsizex&) ! d‚calage h Endif @Fdtest Case 8 A!=True If Right$(Clp$,1)=Chr$(0) If Len(Clp$)>2 Clp$=Left$(Clp$,Len(Clp$)-3) Else Clr Clp$ Endif Endif If Len(Clp$)>0 Clp$=Left$(Clp$,Len(Clp$)-1) If Len(Clp$)<=1 Clr Clp$ ~@Infow(3,"") Endif Endif Case 27,225 ! undo A!=True Clr Clp$ ~@Infow(3,"") Case 32 To A!=True ' If Len(Clp$)=0 Clp$="*" Else if Right$(Clp$,1)=Chr$(0) Clp$="*" Endif ' Clp$=Clp$+Chr$(Key&) Endselect If A! If Len(Clp$)>0 If Right$(Clp$,1)<>Chr$(0) If Left$(Clp$,1)="*" ~@Infow(3,"["+Mid$(Clp$,2)+"] a=A (^Return)") Else ~@Infow(3,"["+Mid$(Clp$,2)+"] a<>A (^Return)") Endif ' Else ' ~@Infow(3,"Suivant: ^Return") Endif Endif Endif ' Return A! Endfunc ' ' Charger image Procedure Clp_img(X&) Local Adr%,L% Local File$,A$ Local Fileh& Local W&,H&,P& ' If Imp(X&=-1,Wopen!(2)) W&=640 H&=480 If Iclp%>0 ~@Mfree(Iclp%) ~@Mfree(Imf%) Endif ' Adr%=Fgetdta() If X&=0 File$=@Fsel$("\*.BLK","","Voir fichier image") Else if Abs(X&)=1 File$=Scrap$+"SCRAP.BLK"+Chr$(0) Else if Abs(X&)=2 File$=File$(4)+Chr$(0) Else File$="" Endif ' If Len(File$)>0 If @Exist(File$) ' Gosub Defmouse(2) Fileh&=@Fopen(File$,0) If @Tsterr(Fileh&) L%=Long{Adr%+26} If L%>6 Iclp%=@Malloc(L%) Imf%=@Malloc(20) ! mfdb If Iclp%>0 And Imf%>0 If @Tsterr(@Fadrread(Fileh&,Iclp%,6)) W&=Card{Iclp%}+1 H&=Card{Iclp%+2}+1 P&=Card{Iclp%+4} ' If P&=Plans& If 6+((W&+15)\16)*2*H&*P&+6*@Ncol(P&)=L% Long{Imf%}=Iclp% Word{Imf%+4}=W& Word{Imf%+6}=H& Word{Imf%+8}=(W&+15)\16 Word{Imf%+10}=0 Word{Imf%+12}=P& Long{Imf%+14}=@Ncol(N&)*6 Word{Imf%+18}=0 ' ~@Tsterr(@Fadrread(Fileh&,Iclp%,Word{Imf%+8}*2*Word{Imf%+6}*Word{Imf%+12})) Else ~@Mfree(Iclp%) ~@Mfree(Imf%) ~@Form_alert(1,"[1][Erreur de format de fichier!][Annuler]") Endif Else ~@Mfree(Iclp%) ~@Mfree(Imf%) ~@Form_alert(1,"[1][Mauvaise r‚solution!|Passez sous: |Piccolo ou D2M, BV4..][Confirmer]") Endif Else ~@Mfree(Iclp%) ~@Mfree(Imf%) Endif Else ~@Form_error(1,@Errf$(-39)) ~@Mfree(Iclp%) ~@Mfree(Imf%) Endif Else ~@Form_alert(1,"[1][Erreur de format de fichier!][Annuler]") Endif ~@Tsterr(@Fclose(Fileh&)) Endif Endif Endif Gosub Defmouse(0) ' If Iclp%>0 Start_x%(2)=0 Start_y%(2)=0 Wset_max_w(2,W&) Wset_max_h(2,H&) If Not Wopen!(2) ~@Wind_open(2) @W_rdexe Endif ' If Wopen!(2) ' Gosub Wsetsl(2) ' Gosub Rdw_all(2) ' Endif ' A$=Str$(W&)+" X "+Str$(H&)+" X "+Str$(@Ncol(P&)) Select Abs(X&) Case 0,2 ~@Infow(2,"Contenu de "+Left$(File$,Len(File$)-1)+" ("+Str$(Max(0,L%))+"o) - "+A$) Case 1 ~@Infow(2,"Contenu du presse-papier SCRAP.BLK ("+Str$(Max(0,Clplen%-1))+"o) - "+A$) Endselect Else ~@Wind_close(2) ' ~@Infow(2,"Fenˆtre vide") Endif ' Endif ' Return Function Imkey(Key&,Shift&,Key2&) $F% Local A! ' A!=False Select Key& Case 27 Rdw_all(2) Case 32 To 122 If Iclp%>0 ~@Infow(2,Str$(Word{Imf%+4})+" X "+Str$(Word{Imf%+6})+" X "+Str$(@Ncol(Word{Imf%+12}))) Else ~@Infow(2,"Aucune image charg‚e") Endif Endselect ' Return A! Endfunc ' ' ' Procedure Nice4 Local A&,W&,H& Local F& Local B!,C!,D! ' If Nice! ' If Desk_c! Emy2&=Ob_h(Adr%(36),0) Else Clr Emy2& Endif ' F&=&X100000000011111 ' Start_x%(4)=0 Start_y%(4)=0 ' W&=(Vmax_x&+1)*Eccsizex&+Emx&+4 H&=(Vmax_y&+1)*Eccsizey&+Emy&+4+Emy2& Clr B!,C! ' ~Wind_calc(1,F&,W_ex&(4),W_ey&(4),W_ew&(4),W_eh&(4),W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) W_attrw&(4)=W_ew&(4)-W_iw&(4) W_attrh&(4)=W_eh&(4)-W_ih&(4) ' If W&=>W_desk&-W_attrw&(4)-4 B!=True F&=Or(F&,&X111000000000) W&=W_desk&-4 Endif If H&=>H_desk&-W_attrh&(4)-4 C!=True F&=Or(F&,&X111000000) H&=H_desk&-4 Endif If B! And C! F&=Bset(F&,5) Endif If Wflag%(4)=0 Clr F& Endif ' @Wset_flags(4,F&) ! mais pas de setslide! interne seulement If Not Wopen!(4) Start_x%(4)=0 Start_y%(4)=0 Endif ' ~Wind_calc(1,Wflag%(4),W_ex&(4),W_ey&(4),W_ew&(4),W_eh&(4),W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) W_attrw&(4)=W_ew&(4)-W_iw&(4) W_attrh&(4)=W_eh&(4)-W_ih&(4) ' If Not B! W&=W&+W_attrw&(4) Endif If Not C! H&=H&+W_attrh&(4) Endif ' Wset_w(4,W&) Wset_h(4,H&) ' ' Protection Winfo%(4)=@Keytest(Winfo%(4)) ' If Wopen!(4) ' Gosub Field_max ' @Wsetsl(4) ' Setxywh(4,W_ex&(4),W_ey&(4),W_ew&(4),W_eh&(4)) ~@Wind_close(4) ~@Wind_open(4) Endif ' H&=Ob_x(Adr%(36),1) ! d‚part 1er objet W&=(W_iw&(4)-2*H&)-Ob_w(Adr%(36),Dk_sz&)-8 Ob_w(Adr%(36),0)=W_iw&(4) For A&=0 To 4 Ob_x(Adr%(36),A&+Dk_cf&)=(W&*A&)\5+H& Ob_w(Adr%(36),A&+Dk_cf&)=W&\5-8 Ob_x(Adr%(36),A&+Dk_ap&)=(W&*A&)\5+H& Ob_w(Adr%(36),A&+Dk_ap&)=W&\5-8 Next A& For A&=0 To 5 Ob_x(Adr%(36),A&+Dk_rec&)=(W&*A&)\8+H& Ob_w(Adr%(36),A&+Dk_rec&)=W&\8-8 Next A& Ob_w(Adr%(36),Dk_txt&)=(W&*2)\8-8 Ob_x(Adr%(36),Dk_txt&)=W&-Ob_w(Adr%(36),Dk_txt&) ' Ob_x(Adr%(36),Dk_cl&)=Ob_w(Adr%(36),0)-Ob_w(Adr%(36),Dk_cl&)-8 Ob_x(Adr%(36),Dk_sz&)=Ob_w(Adr%(36),0)-Ob_w(Adr%(36),Dk_cl&)-8 ' Endif Return ' ' /// a part /// Procedure Menu_acse Local A&,B& Local E$ Local Flag! ' For A&=0 To Compi& Compinf$(A&)="" Next A& ' Compinf$(1)="Aide m‚moire: (touches du clavier)" Compinf$(2)="" Compinf$(3)= )}=Trace$Cfloat(Mkd$(Cvs(Deg(Min( With Char{Bin$(Cvs(Trace$Cfloat())))))))))))Pi)))))))))))))Abs( Offset Mkf$(Cfloat(Min(Sin( Compinf$(4)=" Effacer ‚cran E (menu)" Compinf$(5)=" Curseur On C (menu)" Compinf$(6)=" Off F (menu)" Compinf$(7)=" Mode 40 Col / (menu)" Compinf$(8)=" 80 Col * (menu)" Compinf$(9)=" Initialiser R (menu)" Compinf$(10)=" Synchroniser \R (menu)" Compinf$(11)=" Mode d'‚mulation M (menu)" Compinf$(12)=" Styles ‚mulateur S (menu)" Compinf$(13)=" Enregistrer couleurs N (menu)" Compinf$(14)=" Sauver page Clic! (menu)" ' B&=14 A&=M_1st& Do Select Ob_type(Adr%(43),A&) Case 20 Clr Flag! Case 28 If Not Btst(Ob_state(Adr%(43),A&),3) E$=Char{Ob_spec(Adr%(43),A&)} If Instr(E$,"^")>0 Or Instr(E$,"\")>0 Or Instr(E$," F")>0 If Not Flag! Compinf$(B&)="*"+String$(79,"-") Inc B& Flag!=True Endif Compinf$(B&)=E$ Inc B& Endif Endif Endselect Compinf$(B&)="*"+String$(79,"-") ' Inc A& Loop until A&>M_em_ca& Return ' /// ' ' Procedure Menu_create Local A& ' If (Not Accessoire!) ' ~@Wind_open(Nombre_w&-1) ' Gosub W_rdexe Gosub Desk_hide ' ~Wind_set(0,14,Card(Swap(Adr%(16))),Card(Adr%(16)),0,0) Gosub Menu_dsk ' ~Form_dial(3,0,0,0,0,X_desk&,Y_desk&,W_desk&,H_desk&) ~Menu_bar(Menu_adr%,1) @Test_menu Endif ' Return ' Procedure Menu_dsk Desk_act!=(Desk_f! Or Desk_i! Or Desk_m!) If Accessoire! If Desk_act! ~@Wind_open(Nombre_w&-1) Else ~@Wind_close(Nombre_w&-1) Endif Else If Desk_act! ~Wind_set(0,14,Card(Swap(Adr%(16))),Card(Adr%(16)),0,0) Else ~Wind_set(0,14,0,0,0,0) Endif ~Form_dial(3,0,0,0,0,X_desk&,Y_desk&,W_desk&,H_desk&) Endif Return ' Procedure Menu_close If Menu_adr%>0 ~Wind_set(0,14,0,0,0,0) ~Form_dial(3,0,0,0,0,X_desk&,Y_desk&,W_desk&,H_desk&) ~Menu_bar(Menu_adr%,0) Endif If Not Set_escape! ! Ne pas quitter sans effacer les champs Erase Menp$() Endif Return ' ' Hide etc Procedure Test_menu Local A&,B& Local I& ' If Not Accessoire! If Menu_adr%>0 If Not Set_wdial! ' I&=M_first&-M_ed_a_f& Clr I& ' If Dim?(Edited!()) ' If Emulm|=0 ~Menu_ienable(Menu_adr%,M_em_40&,0) Else ~Menu_ienable(Menu_adr%,M_em_40&,1) Endif ' ~Menu_ienable(Menu_adr%,M_a_r&,-Set_speed!) ~Menu_ienable(Menu_adr%,M_efface&,-Set_speed!) ' ' If Len(binair$)>0 If Binp%>0 ~Menu_ienable(Menu_adr%,M_f4&,1) ~Menu_ienable(Menu_adr%,M_xt&,1) Else ~Menu_ienable(Menu_adr%,M_f4&,0) ~Menu_ienable(Menu_adr%,M_xt&,0) Endif ' ' 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 ' Endif ' If Padx3! ~Menu_icheck(Menu_adr%,M_em_pad&,1) Else ~Menu_icheck(Menu_adr%,M_em_pad&,0) Endif ' If Connect! ~Menu_icheck(Menu_adr%,M_em_cnx&,1) Else ~Menu_icheck(Menu_adr%,M_em_cnx&,0) Endif ' If Magneto&=1 Or Magneto&=2 ~Menu_ienable(Menu_adr%,M_c_n&,0) Else ~Menu_ienable(Menu_adr%,M_c_n&,1) 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_drcs&,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) A&=@Firstw Select A& Case 4 ~Menu_icheck(Menu_adr%,M_c_t&,1) 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_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 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 Endif Endif Return ' ' ' ' Index: 0=hide 1=show ' Procedure Hide_menu(Index&) ' ' ' Return Procedure Add_menu(Ha&) ' If Not Accessoire! ' @Menu_create ' Endif If Ha&>-1 Set_col(True) Else Set_col(False) Endif @Test_menu 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$ ' E$="SWIFTELP.RSC" If Work_out(4)=278*$ And And And And Eqv And ! 556 E$="SWIFTLOW.RSC" If Not @Fexist(E$) If @Form_alert(1,"[3][Le fichier SWIFTELP.RSC |est introuvable! ][ Chercher | Annuler ]")=1 E$=@Fsel$("\SWIFTLOW.RSC","SWIFTLOW.RSC","Chercher ReSsourCe") If Not @Exist(E$) E$="SWIFTELP.RSC" Endif Else E$="SWIFTELP.RSC" Endif Endif Endif ' If @Fexist(E$) A%=Rsrc_load(E$) Else If @Form_alert(1,"[3][Le fichier SWIFTELP.RSC |est introuvable! ][ Chercher | Quitter ]")=1 E$=@Fsel$("\SWIFTELP.RSC","SWIFTELP.RSC","Chercher ReSsourCe") If @Exist(E$) Gosub Defmouse(2) A%=Rsrc_load(E$) Endif Endif Endif ' If A%<=0 If A%=-33 ~@Form_alert(1,Errn33$) Else ~@Form_alert(1,"[1][ProblŠmes de chargement.. ][ Quitter ]") Endif ' Gosub Uninit On error gosub Eop Edit Endif Return ' Procedure Rsrc_gaddr Local A& Local X&,Y&,N& ' Gosub Rsc_defs ! d‚clarations M_run4&=M_run1&+3 ' 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& ' ~Rsrc_gaddr(0,Options&,Adr%(1)) ~Rsrc_gaddr(0,Infos&,Adr%(2)) ~Rsrc_gaddr(0,Text&,Adr%(5)) ~Rsrc_gaddr(0,Hlp_emul&,Adr%(6)) ~Rsrc_gaddr(0,Em_setup&,Adr%(7)) ~Rsrc_gaddr(0,Emulcol&,Adr%(8)) ~Rsrc_gaddr(0,Em_motif&,Adr%(9)) ~Rsrc_gaddr(0,Progress&,Adr%(21)) ~Rsrc_gaddr(0,Envoi&,Adr%(22)) ~Rsrc_gaddr(0,Envslw&,Adr%(23)) ~Rsrc_gaddr(0,Em_pannel&,Adr%(26)) ~Rsrc_gaddr(0,Sw2&,Adr%(31)) ~Rsrc_gaddr(0,Sbox&,Adr%(32)) ~Rsrc_gaddr(0,Finfo&,Adr%(33)) ~Rsrc_gaddr(0,Statem&,Adr%(39)) ~Rsrc_gaddr(0,Popup&,Adr%(41)) ~Rsrc_gaddr(0,Menu&,Adr%(43)) ' ~Rsrc_gaddr(0,register&,Adr%(3)) ' ~Rsrc_gaddr(0,thanks&,Adr%(4)) ~Rsrc_gaddr(0,Menulow&,Adr%(10)) ~Rsrc_gaddr(0,Appl&,Adr%(11)) ~Rsrc_gaddr(0,Enr&,Adr%(12)) ~Rsrc_gaddr(0,Modm&,Adr%(13)) ~Rsrc_gaddr(0,Opts&,Adr%(14)) ~Rsrc_gaddr(0,Captr&,Adr%(15)) ~Rsrc_gaddr(0,Desk&,Adr%(16)) ~Rsrc_gaddr(0,Memoire&,Adr%(17)) ~Rsrc_gaddr(0,Rscnf&,Adr%(18)) ~Rsrc_gaddr(0,Edt&,Adr%(19)) ~Rsrc_gaddr(0,Edo&,Adr%(20)) ~Rsrc_gaddr(0,Entr&,Adr%(24)) ~Rsrc_gaddr(0,Photo&,Adr%(25)) ~Rsrc_gaddr(0,Prgexe&,Adr%(27)) ~Rsrc_gaddr(0,Transf&,Adr%(28)) ~Rsrc_gaddr(0,Coldsk&,Adr%(29)) ~Rsrc_gaddr(0,Seltrm&,Adr%(30)) ~Rsrc_gaddr(0,Eos&,Adr%(34)) ~Rsrc_gaddr(0,Menux&,Adr%(35)) ~Rsrc_gaddr(0,Mclav&,Adr%(36)) ~Rsrc_gaddr(0,Xpop&,Adr%(37)) ~Rsrc_gaddr(0,Install&,Adr%(38)) ~Rsrc_gaddr(0,Fact&,Adr%(40)) ~Rsrc_gaddr(0,Fnt&,Adr%(44)) ' ' V‚rifie le menu (cd proc verify_menu) Gosub Verify_menu ' For A&=0 To Tree& If Adr%(A&)>0 ' If (A&>14 Or A&<10) And A&<>43 ' If W_desk&*H_desk&<>0 ! limiter w,h ' Ob_w(Adr%(A&),0)=Min(Ob_w(Adr%(A&),0),W_desk&) ' Ob_h(Adr%(A&),0)=Min(Ob_h(Adr%(A&),0),H_desk&) ' Endif ' If A&<>43 And A&<>10 And A&<>16 And A&<>35 ~Form_center(Adr%(A&),Rx&(A&),Ry&(A&),Rw&(A&),Rh&(A&)) Endif ' Endif Endif Next A& ' Ob_x(Adr%(16),0)=X_desk& Ob_y(Adr%(16),0)=Y_desk& Ob_w(Adr%(16),0)=W_desk& Ob_h(Adr%(16),0)=H_desk& Ob_y(Adr%(16),Dk_bar&)=H_desk&-Ob_h(Adr%(16),Dk_bar&) Ob_w(Adr%(16),Dk_bar&)=Ob_x(Adr%(16),Dk_f10&)+Ob_w(Adr%(16),Dk_f10&)+4 ' ' '''Gosub Getcol ! deskcol TROP LENT Gosub Load_dsk ' Ob_spec(Adr%(16),0)=Or(And(Ob_spec(Adr%(16),0),&HFFFFFFF0),Dcol&) Ob_spec(Adr%(16),0)=Or(And(Ob_spec(Adr%(16),0),&HFFFFFF8F),Rol(Dstyl&,4)) Ob_spec(Adr%(16),Dk_bar&)=Or(And(Ob_spec(Adr%(16),Dk_bar&),&HFFFFFFF0),Dcol&) Ob_spec(Adr%(16),Dk_bar&)=Or(And(Ob_spec(Adr%(16),Dk_bar&),&HFFFFFF8F),Rol(Dstyl&,4)) Ob_spec(Adr%(16),Dk_boxc&)=Or(And(Ob_spec(Adr%(16),Dk_boxc&),&HFFFFFFF0),Dcol&) Ob_spec(Adr%(16),Dk_boxc&)=Or(And(Ob_spec(Adr%(16),Dk_boxc&),&HFFFFFF8F),Rol(Dstyl&,4)) Ob_flags(Adr%(16),Dk_rp2&+1)=Bset(Ob_flags(Adr%(16),Dk_rp2&+1),7) ! hide objet dummy dans clavier2 (bureau) ' Select Plans& Case 1 Word{Ob_spec(Adr%(2),1)+12}=0 ! effacer ombre Word{Ob_spec(Adr%(2),2)+12}=1 ! logo Case 2 Word{Ob_spec(Adr%(2),1)+12}=1 ! ombre Word{Ob_spec(Adr%(2),2)+12}=3 ! logo ' Case 4,8,16,24 ! ok Endselect ' ' If Len(Desk$)>0 Swn(Dk_em&,Desk$) Swn(Dk_fil&,Desk$) Swn(Dk_prn&,Desk$) Swn(Dk_clp&,Desk$) Swn(Dk_cor&,Desk$) Swn(Dk_mod&,Desk$) Swn(Dk_bar&,Desk$) If Len(Desk$)>0 Swn(Dk_boxc&,Desk$) Endif ' ' Swn(Dk_cf&,Desk$) ' Swn(Dk_so&,Desk$) ' Swn(Dk_an&,Desk$) ' Swn(Dk_re&,Desk$) ' Swn(Dk_rp&,Desk$) ' Swn(Dk_gu&,Desk$) ' Swn(Dk_co&,Desk$) ' Swn(Dk_su&,Desk$) ' Swn(Dk_en&,Desk$) ' ' Swn(Dk_bar2&,Desk$) ' ' ' Taille clavier en bas If Desk_c! Emy2&=Ob_h(Adr%(36),0) Else Emy2&=0 Endif ' ' ' Eviter que la boite d'info ne soit "slimfast‚e" Ob_h(Adr%(2),0)=Max(136,Ob_h(Adr%(2),0)) A&=-1 Repeat Inc A& Ob_flags(Adr%(2),A&)=And(Ob_flags(Adr%(2),A&),&X1111111101100111) Ob_state(Adr%(2),A&)=And(Ob_state(Adr%(2),A&),&X110001) Until Btst(Ob_flags(Adr%(2),A&),5) ' ' Endif ' ' Recalculer taille des icones bureau.. A&=-1 Repeat Inc A& Select Ob_type(Adr%(16),A&) Case 31,33 Ob_w(Adr%(16),A&)=72 ! ne change pas selon r‚solution! Ob_h(Adr%(16),A&)=40 Endselect Until Btst(Ob_flags(Adr%(16),A&),5) ! lastob ' ' Exadr%=-1 ! buffer addr pour Get/Put ' En_6&=En_1&+6 Px_last&=Px_first&+7 ' Am_last&=Am_first&+5 ' Char{{Ob_spec(Adr%(6),Am_first&)}}="3611" Char{{Ob_spec(Adr%(6),Am_first&+1)}}="3614" Char{{Ob_spec(Adr%(6),Am_first&+2)}}="3615" 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)}}="36011515" ' If Len(Num$)>0 For A&=Am_first& To Am_first&+5 Char{{Ob_spec(Adr%(6),A&)}}=Left$(@Flin$(Num$),12) Next A& Endif ' Char{{Ob_spec(Adr%(39),Es_id&)}}="" ! USER ID ' Char{{Ob_spec(Adr%(6),Am_se&)}}="ATZ" Char{{Ob_spec(Adr%(6),Am_co&)}}="" ' Char{{Ob_spec(Adr%(36),Dk_txt&)}}="STOP" Char{{Ob_spec(Adr%(16),Dk_txt2&)}}="STOP" ' ' Char{Ob_spec(Adr%(2),2)}="-SwifteL!-> "+Release$ Char{{Ob_spec(Adr%(2),Vers&)}}="Version "+Release$ ' ' ' 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%(41) Adrxpop%=Adr%(37) @Popinit For X&=1 To Tree& If Adr%(X&)>0 @Popset(Adr%(X&)) Endif Next X& ' ~Objc_offset(Adr%(43),M_infos&,X&,Y&) Y_desk&=Min(Max(Y_desk&,Y&),64) ' Chrsc!=False ' If Not Accessoire! ' If W_desk&<640 ! tros petit! ' Chrsc!=True ' For X&=0 To 6 ' For Y&=0 To 4 ' If X&<>6 ' ~Menu_text(Adr%(43),M_1st&+X&,Mid$(Char{Ob_spec(Adr%(43),M_1st&+X&)},2,4)+Chr$(0)) ' Ob_w(Adr%(43),M_1st&+X&)=5*8 ' Endif ' Ob_x(Adr%(43),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*5*8+8 ' Ob_x(Adr%(Menu&),M_f2&-1)=3*5*8+8 ' Ob_x(Adr%(Menu&),M_efface&-1)=Min(4*5*8+8,W_desk&-Ob_w(Adr%(Menu&),M_efface&-1)) ' Ob_x(Adr%(Menu&),M_c_n&-1)=Min(5*5*8+8,W_desk&-Ob_w(Adr%(Menu&),M_c_n&-1)) ' Ob_x(Adr%(Menu&),M_first&-1)=Min(6*5*8+8,W_desk&-Ob_w(Adr%(Menu&),M_first&-1)) ' Next X& ' Endif ' Endif ' ' If Chrsc! Gosub Rsc_cut ' Endif ' Gosub New_pop(Adr%(20),Eo_fct&,"[Sommaire|Annulation|Retour|R‚p‚tition|Guide|Correction|Suite|Envoi|Cnx/Fin|D‚connexion]") Gosub New_pop(Adr%(20),Eo_dcn&,"[Connexion|D‚connexion]") Gosub New_pop(Adr%(20),Eo_yent&,"[#0|#1|#2|#3|#4|#5|#6|#7|#8|#9]") Gosub New_pop(Adr%(39),Es_mod&,"[40 colonnes|80 Am‚ricain|80 Fran‡ais|Terminal VT100]") Gosub New_pop(Adr%(39),Es_rep&,"[Inactif|Minitel 1|Minitel 1B|Minitel 2|Minitel photo]") Gosub New_pop(Adr%(8),Ec_term&,"[Noir|Bleu|Rouge|Magenta|Vert|Cyan|Jaune|Blanc]") Gosub New_pop(Adr%(8),Ec_term2&,"[Noir|Bleu|Rouge|Magenta|Vert|Cyan|Jaune|Blanc]") ' Return Procedure Rsc_defs Rem Indice du ressource pour SWIFTELP ' Let Infos&=0 ! Formulaire/Dialogue Let Swid&=2 ! IMAGE dans l'arbre INFOS Let Noreg&=3 ! BOXTEXT dans l'arbre INFOS Let Okinf&=9 ! BUTTON dans l'arbre INFOS Let Vers&=11 ! TEXT dans l'arbre INFOS ' Let Desk&=1 ! Formulaire/Dialogue Let Dk_em&=1 ! USERDEF dans l'arbre DESK Let Dk_fil&=2 ! USERDEF dans l'arbre DESK Let Dk_mod&=3 ! USERDEF dans l'arbre DESK Let Dk_clp&=4 ! USERDEF dans l'arbre DESK Let Dk_prn&=5 ! USERDEF dans l'arbre DESK Let Dk_cor&=6 ! USERDEF dans l'arbre DESK Let Dk_bar&=7 ! IBOX dans l'arbre DESK Let Dk_f1&=8 ! BOX dans l'arbre DESK Let Dk_f2&=11 ! BOX dans l'arbre DESK Let Dk_f3&=14 ! BOX dans l'arbre DESK Let Dk_f4&=17 ! BOX dans l'arbre DESK Let Dk_f5&=20 ! BOX dans l'arbre DESK Let Dk_f6&=23 ! BOX dans l'arbre DESK Let Dk_f7&=26 ! BOX dans l'arbre DESK Let Dk_f8&=29 ! BOX dans l'arbre DESK Let Dk_f9&=32 ! BOX dans l'arbre DESK Let Dk_f10&=35 ! BOX dans l'arbre DESK Let Dk_boxc&=38 ! IBOX dans l'arbre DESK Let Dk_cf2&=39 ! BOXTEXT dans l'arbre DESK Let Dk_so2&=40 ! BOXTEXT dans l'arbre DESK Let Dk_an2&=41 ! BOXTEXT dans l'arbre DESK Let Dk_re2&=42 ! BOXTEXT dans l'arbre DESK Let Dk_rp2&=43 ! BOXTEXT dans l'arbre DESK Let Dk_ap2&=45 ! BOXTEXT dans l'arbre DESK Let Dk_gu2&=46 ! BOXTEXT dans l'arbre DESK Let Dk_co2&=47 ! BOXTEXT dans l'arbre DESK Let Dk_su2&=48 ! BOXTEXT dans l'arbre DESK Let Dk_en2&=49 ! BOXTEXT dans l'arbre DESK Let Dk_rec2&=50 ! BOXTEXT dans l'arbre DESK Let Dk_arr2&=51 ! BOXTEXT dans l'arbre DESK Let Dk_ava2&=52 ! BOXTEXT dans l'arbre DESK Let Dk_pla2&=53 ! BOXTEXT dans l'arbre DESK Let Dk_pau2&=54 ! BOXTEXT dans l'arbre DESK Let Dk_sto2&=55 ! BOXTEXT dans l'arbre DESK Let Dk_txt2&=56 ! BOXTEXT dans l'arbre DESK ' Let Options&=2 ! Formulaire/Dialogue Let Rsc_1200&=4 ! BUTTON dans l'arbre OPTIONS Let Rsc_ser&=6 ! BUTTON dans l'arbre OPTIONS Let Rsc_vl&=7 ! FTEXT dans l'arbre OPTIONS Let Rsc_reg&=9 ! BUTTON dans l'arbre OPTIONS Let Rsc_sty&=10 ! BUTTON dans l'arbre OPTIONS Let Rsc_mod&=12 ! BUTTON dans l'arbre OPTIONS Let Rsc_rep&=13 ! BUTTON dans l'arbre OPTIONS Let Rsc_parx&=15 ! BUTTON dans l'arbre OPTIONS Let Rsc_fq&=19 ! BOX dans l'arbre OPTIONS Let Rsc_nice&=21 ! BOX dans l'arbre OPTIONS Let Rsc_tc&=23 ! BOX dans l'arbre OPTIONS Let Rsc_ti&=26 ! BOX dans l'arbre OPTIONS Let Rsc_tf&=28 ! BOX dans l'arbre OPTIONS Let Rsc_tc2&=30 ! BOX dans l'arbre OPTIONS Let Rsc_hlp&=32 ! BOX dans l'arbre OPTIONS Let Rsc_eff&=34 ! BOX dans l'arbre OPTIONS Let Rsc_log&=36 ! BOX dans l'arbre OPTIONS Let Rsc_col&=38 ! BOX dans l'arbre OPTIONS Let Rsc_gris&=40 ! BOX dans l'arbre OPTIONS Let Rsc_ok&=41 ! BUTTON dans l'arbre OPTIONS Let Rsc_save&=42 ! BUTTON dans l'arbre OPTIONS Let Rsc_cancel&=43 ! BUTTON dans l'arbre OPTIONS ' Let Rscnf&=3 ! Formulaire/Dialogue Let Cs_mod&=4 ! BUTTON dans l'arbre RSCNF Let Cs_1&=6 ! BUTTON dans l'arbre RSCNF Let Cs_2&=8 ! BUTTON dans l'arbre RSCNF Let Cs_3&=10 ! BUTTON dans l'arbre RSCNF Let Cs_4&=12 ! BUTTON dans l'arbre RSCNF Let Cs_ok&=15 ! BUTTON dans l'arbre RSCNF ' Let Modm&=4 ! Formulaire/Dialogue Let Md_1&=6 ! FTEXT dans l'arbre MODM Let Md_ok&=18 ! BUTTON dans l'arbre MODM ' Let Em_setup&=5 ! 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&=15 ! BOX dans l'arbre EM_SETUP Let Cv_ok&=16 ! BUTTON dans l'arbre EM_SETUP ' Let Emulcol&=6 ! 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_bn&=13 ! BOX dans l'arbre EMULCOL Let Ec_bc&=15 ! BOX dans l'arbre EMULCOL Let Ec_box&=17 ! BOX dans l'arbre EMULCOL Let Ec_bxr&=18 ! BOX dans l'arbre EMULCOL Let Ec_inv&=21 ! BUTTON dans l'arbre EMULCOL Let Ec_term&=24 ! BUTTON dans l'arbre EMULCOL Let Ec_term2&=26 ! BUTTON dans l'arbre EMULCOL Let Ec_text&=27 ! BUTTON dans l'arbre EMULCOL Let Ec_save&=29 ! BUTTON dans l'arbre EMULCOL Let Ec_ok&=30 ! BUTTON dans l'arbre EMULCOL ' Let Text&=7 ! Formulaire/Dialogue Let Rsc_box&=6 ! BOX dans l'arbre TEXT Let Dm_1&=7 ! BUTTON dans l'arbre TEXT Let Dm_2&=8 ! BUTTON dans l'arbre TEXT Let Dm_3&=9 ! BUTTON dans l'arbre TEXT Let Dm_m1&=12 ! BUTTON dans l'arbre TEXT Let Dm_w&=13 ! BOXTEXT dans l'arbre TEXT Let Dm_p1&=14 ! BUTTON dans l'arbre TEXT Let Dm_m2&=16 ! BUTTON dans l'arbre TEXT Let Dm_h&=17 ! BOXTEXT dans l'arbre TEXT Let Dm_p2&=18 ! BUTTON dans l'arbre TEXT Let Rsc_stdw&=19 ! BUTTON dans l'arbre TEXT Let Rsc_stx&=20 ! TEXT dans l'arbre TEXT Let Rsc_stup&=22 ! BUTTON dans l'arbre TEXT Let Rsc_fdw&=23 ! BUTTON dans l'arbre TEXT Let Rsc_id&=24 ! BOXTEXT dans l'arbre TEXT Let Rsc_fup&=25 ! BUTTON dans l'arbre TEXT Let Dm_fnt&=26 ! BUTTON dans l'arbre TEXT Let Rsc_stok&=27 ! BUTTON dans l'arbre TEXT ' Let Statem&=8 ! Formulaire/Dialogue Let Es_mod&=5 ! BUTTON dans l'arbre STATEM Let Es_rep&=8 ! BUTTON dans l'arbre STATEM Let Es_pub&=9 ! FTEXT dans l'arbre STATEM Let Es_emu&=11 ! BOX dans l'arbre STATEM Let Es_cn&=13 ! BOX dans l'arbre STATEM Let Es_ro&=15 ! BOX dans l'arbre STATEM Let Es_curs&=17 ! BOX dans l'arbre STATEM Let Es_d0&=19 ! BOX dans l'arbre STATEM Let Es_d1&=21 ! BOX dans l'arbre STATEM Let Es_pad&=23 ! BOX dans l'arbre STATEM Let Es_deb&=25 ! BOX dans l'arbre STATEM Let Es_prix&=27 ! BOX dans l'arbre STATEM Let Es_cla&=29 ! BOX dans l'arbre STATEM Let Es_rtm&=31 ! BOX dans l'arbre STATEM Let Es_rs&=32 ! BUTTON dans l'arbre STATEM Let Es_xt&=34 ! FTEXT dans l'arbre STATEM Let Es_yt&=36 ! FTEXT dans l'arbre STATEM Let Es_id&=37 ! FTEXT dans l'arbre STATEM Let Es_ok&=38 ! BUTTON dans l'arbre STATEM Let Es_sv&=39 ! BUTTON dans l'arbre STATEM Let Es_pho&=40 ! BUTTON dans l'arbre STATEM Let Es_ann&=41 ! BUTTON dans l'arbre STATEM ' Let Memoire&=9 ! Formulaire/Dialogue Let Mem_1&=4 ! FTEXT dans l'arbre MEMOIRE Let Mem_2&=5 ! FTEXT dans l'arbre MEMOIRE Let Mem_3&=6 ! FTEXT dans l'arbre MEMOIRE Let Mem_4&=7 ! FTEXT dans l'arbre MEMOIRE Let Mem_5&=9 ! FTEXT dans l'arbre MEMOIRE Let Mem_6&=10 ! FTEXT dans l'arbre MEMOIRE ' Let Photo&=10 ! Formulaire/Dialogue Let Pho_opt&=4 ! BUTTON dans l'arbre PHOTO Let Pho_pal&=6 ! BUTTON dans l'arbre PHOTO Let Pho_trm&=8 ! BUTTON dans l'arbre PHOTO Let Pho_mem&=10 ! FTEXT dans l'arbre PHOTO Let Pho_env&=12 ! BOX dans l'arbre PHOTO Let Pho_acc&=14 ! BOX dans l'arbre PHOTO Let Pho_svf&=16 ! BOX dans l'arbre PHOTO Let Pho_ok&=17 ! BUTTON dans l'arbre PHOTO Let Pho_sv&=18 ! BUTTON dans l'arbre PHOTO ' Let Seltrm&=11 ! Formulaire/Dialogue Let Trm_rim&=5 ! BUTTON dans l'arbre SELTRM Let Trm_trm&=6 ! BUTTON dans l'arbre SELTRM Let Trm_1&=8 ! STRING dans l'arbre SELTRM Let Trm_up&=16 ! BOXTEXT dans l'arbre SELTRM Let Trm_dw&=17 ! BOXTEXT dans l'arbre SELTRM Let Trm_ann&=18 ! BUTTON dans l'arbre SELTRM ' Let Opts&=12 ! Formulaire/Dialogue Let Opt_1&=4 ! BOX dans l'arbre OPTS Let Opt_2&=6 ! BOX dans l'arbre OPTS Let Opt_3&=8 ! BOX dans l'arbre OPTS Let Opt_4&=10 ! BOX dans l'arbre OPTS Let Opt_5&=12 ! BOX dans l'arbre OPTS Let Opt_6&=14 ! BOX dans l'arbre OPTS Let Opt_7&=16 ! BOX dans l'arbre OPTS Let Opt_8&=18 ! BOX dans l'arbre OPTS Let Opt_ok&=19 ! BUTTON dans l'arbre OPTS ' Let Menu&=13 ! Arbre menu Let M_1st&=3 ! TITLE dans l'arbre MENU Let M_title&=7 ! TITLE dans l'arbre MENU Let M_ii&=8 ! TITLE dans l'arbre MENU Let M_infos&=11 ! STRING dans l'arbre MENU Let M_f3&=20 ! STRING dans l'arbre MENU Let M_f4&=21 ! STRING dans l'arbre MENU Let M_xt&=22 ! STRING dans l'arbre MENU Let M_f3b&=24 ! STRING dans l'arbre MENU Let M_finfo&=26 ! STRING dans l'arbre MENU Let M_fdel&=27 ! STRING dans l'arbre MENU Let M_run1&=29 ! STRING dans l'arbre MENU Let M_go&=33 ! STRING dans l'arbre MENU Let M_som&=35 ! STRING dans l'arbre MENU Let M_c_q&=36 ! STRING dans l'arbre MENU Let M_f5&=38 ! STRING dans l'arbre MENU Let M_c_e&=39 ! STRING dans l'arbre MENU Let M_c_go&=40 ! STRING dans l'arbre MENU Let M_c_e2&=42 ! STRING dans l'arbre MENU Let M_a_e&=44 ! STRING dans l'arbre MENU Let M_efface&=46 ! STRING dans l'arbre MENU Let M_c_rr&=48 ! STRING dans l'arbre MENU Let M_a_r&=49 ! STRING dans l'arbre MENU Let M_dwn&=51 ! STRING dans l'arbre MENU Let M_upl&=52 ! STRING dans l'arbre MENU Let M_em_cal&=54 ! STRING dans l'arbre MENU Let M_em_t&=55 ! STRING dans l'arbre MENU Let M_em_f4&=56 ! STRING dans l'arbre MENU Let M_em_fac&=57 ! STRING dans l'arbre MENU Let M_em_cnx&=59 ! STRING dans l'arbre MENU Let M_em_pad&=60 ! STRING dans l'arbre MENU Let M_em_cls&=62 ! STRING dans l'arbre MENU Let M_em_on&=63 ! STRING dans l'arbre MENU Let M_em_off&=64 ! STRING dans l'arbre MENU Let M_em_40&=65 ! STRING dans l'arbre MENU Let M_em_80&=66 ! STRING dans l'arbre MENU Let M_em_in&=68 ! STRING dans l'arbre MENU Let M_c_n&=70 ! STRING dans l'arbre MENU Let M_c_f&=71 ! STRING dans l'arbre MENU Let M_c_f2&=72 ! STRING dans l'arbre MENU Let M_icn&=73 ! STRING dans l'arbre MENU Let M_c_k&=74 ! STRING dans l'arbre MENU Let M_c_w&=75 ! STRING dans l'arbre MENU Let M_c_t&=76 ! STRING dans l'arbre MENU Let M_c_p&=78 ! STRING dans l'arbre MENU Let M_em_dsk&=80 ! STRING dans l'arbre MENU Let M_em_equ&=81 ! STRING dans l'arbre MENU Let M_em_pho&=82 ! STRING dans l'arbre MENU Let M_trn&=83 ! STRING dans l'arbre MENU Let M_exe&=84 ! STRING dans l'arbre MENU Let M_em_mod&=85 ! STRING dans l'arbre MENU Let M_em_ca&=86 ! STRING dans l'arbre MENU Let M_em_col&=87 ! STRING dans l'arbre MENU Let M_em_mem&=89 ! STRING dans l'arbre MENU Let M_em_sv&=91 ! STRING dans l'arbre MENU ' Let Menulow&=14 ! Arbre menu ' Let Menux&=15 ! Arbre menu Let X_inf&=7 ! STRING dans l'arbre MENUX Let X_wup&=16 ! STRING dans l'arbre MENUX Let X_cq&=18 ! STRING dans l'arbre MENUX ' Let Hlp_emul&=16 ! 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_com&=32 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_co&=33 ! FTEXT dans l'arbre HLP_EMUL Let Am_first&=34 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_seq&=40 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_se2&=41 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_se&=42 ! FTEXT dans l'arbre HLP_EMUL Let Am_cnx&=44 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_dcn&=45 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_lin&=47 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_lib&=48 ! BOXTEXT dans l'arbre HLP_EMUL Let Am_cancel&=49 ! BUTTON dans l'arbre HLP_EMUL ' Let Em_motif&=17 ! Formulaire/Dialogue ' Let Envoi&=18 ! Formulaire/Dialogue Let En_dest&=4 ! BUTTON dans l'arbre ENVOI Let En_slw&=6 ! BUTTON dans l'arbre ENVOI Let En_wait&=8 ! BOX dans l'arbre ENVOI Let En_no&=9 ! FTEXT dans l'arbre ENVOI Let En_env&=10 ! BUTTON dans l'arbre ENVOI Let En_ok&=11 ! BUTTON dans l'arbre ENVOI ' Let Envslw&=19 ! Formulaire/Dialogue Let Ens_spd&=4 ! BUTTON dans l'arbre ENVSLW Let Ens_asc&=6 ! BUTTON dans l'arbre ENVSLW Let Ens_pau&=8 ! BUTTON dans l'arbre ENVSLW Let Ens_len&=10 ! FTEXT dans l'arbre ENVSLW Let Ens_ok&=11 ! BUTTON dans l'arbre ENVSLW ' Let Captr&=20 ! Formulaire/Dialogue Let Cp_inf&=2 ! BUTTON dans l'arbre CAPTR Let Cp_typ&=4 ! BUTTON dans l'arbre CAPTR Let Cp_enr&=6 ! BUTTON dans l'arbre CAPTR Let Cp_txt&=7 ! STRING dans l'arbre CAPTR Let Cp_n&=8 ! STRING dans l'arbre CAPTR Let Cp_ok&=9 ! BUTTON dans l'arbre CAPTR Let Cp_stop&=10 ! BUTTON dans l'arbre CAPTR Let Cp_ann&=11 ! BUTTON dans l'arbre CAPTR ' Let Appl&=21 ! Formulaire/Dialogue Let Ap_id&=3 ! FBOXTEXT dans l'arbre APPL Let Ap_l1&=7 ! STRING dans l'arbre APPL Let Ap_l2&=8 ! STRING dans l'arbre APPL Let Ap_up&=23 ! BUTTON dans l'arbre APPL Let Ap_bs&=24 ! BOX dans l'arbre APPL Let Ap_sl&=25 ! BOX dans l'arbre APPL Let Ap_dw&=26 ! BUTTON dans l'arbre APPL Let Ap_enr&=27 ! BUTTON dans l'arbre APPL Let Ap_mod&=28 ! BUTTON dans l'arbre APPL Let Ap_del&=29 ! BUTTON dans l'arbre APPL Let Ap_ok&=30 ! BUTTON dans l'arbre APPL Let Ap_ann&=31 ! BUTTON dans l'arbre APPL ' Let Fact&=22 ! Formulaire/Dialogue Let Com_b1&=6 ! BOX dans l'arbre FACT Let Com_1&=7 ! STRING dans l'arbre FACT Let Com_b2&=15 ! BOX dans l'arbre FACT Let Com_2&=16 ! STRING dans l'arbre FACT Let Com_b3&=24 ! BOX dans l'arbre FACT Let Com_3&=25 ! STRING dans l'arbre FACT Let Com_up&=33 ! BUTTON dans l'arbre FACT Let Com_bs&=34 ! BOX dans l'arbre FACT Let Com_sl&=35 ! BOX dans l'arbre FACT Let Com_dw&=36 ! BUTTON dans l'arbre FACT Let Com_2b&=38 ! STRING dans l'arbre FACT Let Com_3b&=39 ! STRING dans l'arbre FACT Let Com_ok&=40 ! BUTTON dans l'arbre FACT ' Let Enr&=23 ! Formulaire/Dialogue Let Rg_1&=1 ! FBOXTEXT dans l'arbre ENR Let Rg_2&=2 ! FBOXTEXT dans l'arbre ENR Let Rg_ok&=3 ! BUTTON dans l'arbre ENR Let Rg_mod&=4 ! BUTTON dans l'arbre ENR Let Rg_ann&=5 ! BUTTON dans l'arbre ENR ' Let Prgexe&=24 ! Formulaire/Dialogue Let Ex_1&=4 ! BUTTON dans l'arbre PRGEXE Let Ex_aut&=8 ! BUTTON dans l'arbre PRGEXE Let Ex_sv&=9 ! BUTTON dans l'arbre PRGEXE ' Let Transf&=25 ! Formulaire/Dialogue Let Tr_re&=3 ! BUTTON dans l'arbre TRANSF Let Tr_rex&=4 ! FTEXT dans l'arbre TRANSF Let Tr_em&=5 ! BUTTON dans l'arbre TRANSF Let Tr_emx&=6 ! FTEXT dans l'arbre TRANSF Let Tr_ok&=7 ! BUTTON dans l'arbre TRANSF Let Tr_sv&=8 ! BUTTON dans l'arbre TRANSF Let Tr_ann&=9 ! BUTTON dans l'arbre TRANSF ' Let Em_pannel&=26 ! Formulaire/Dialogue Let Em_p1&=2 ! BOX dans l'arbre EM_PANNEL Let Em_pm&=12 ! BUTTON dans l'arbre EM_PANNEL Let Em_bs&=13 ! BOX dans l'arbre EM_PANNEL Let Em_sl&=14 ! BOX dans l'arbre EM_PANNEL Let Em_pp&=15 ! BUTTON dans l'arbre EM_PANNEL Let Em_pc&=16 ! BUTTON dans l'arbre EM_PANNEL ' Let Coldsk&=27 ! Formulaire/Dialogue Let Bc_c1&=4 ! BOX dans l'arbre COLDSK Let Bc_s1&=22 ! BOX dans l'arbre COLDSK Let Bc_box&=31 ! BOX dans l'arbre COLDSK Let Bc_ok&=32 ! BUTTON dans l'arbre COLDSK Let Bc_sv&=33 ! BUTTON dans l'arbre COLDSK Let Bc_ann&=34 ! BUTTON dans l'arbre COLDSK ' Let Popup&=28 ! Formulaire/Dialogue ' Let Xpop&=29 ! Formulaire/Dialogue ' Let Progress&=30 ! 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 Finfo&=31 ! Formulaire/Dialogue Let Fi_text&=2 ! TEXT dans l'arbre FINFO ' Let Sbox&=32 ! Formulaire/Dialogue ' Let Sw2&=33 ! Formulaire/Dialogue ' Let Edt&=34 ! Formulaire/Dialogue Let Ed_box&=4 ! BOX dans l'arbre EDT Let Ed_1&=5 ! STRING dans l'arbre EDT Let Ed_up&=15 ! BUTTON dans l'arbre EDT Let Ed_dw&=16 ! BUTTON dans l'arbre EDT Let Ed_add&=17 ! BUTTON dans l'arbre EDT Let Ed_clr&=18 ! BUTTON dans l'arbre EDT Let Ed_mod&=19 ! BUTTON dans l'arbre EDT Let Ed_new&=20 ! BUTTON dans l'arbre EDT Let Ed_ld&=21 ! BUTTON dans l'arbre EDT Let Ed_sv&=22 ! BUTTON dans l'arbre EDT Let Ed_run&=23 ! BUTTON dans l'arbre EDT Let Ed_ann&=24 ! BUTTON dans l'arbre EDT ' Let Edo&=35 ! Formulaire/Dialogue Let Eo_f1&=3 ! BUTTON dans l'arbre EDO Let Eo_fct&=4 ! BUTTON dans l'arbre EDO Let Eo_env&=5 ! BUTTON dans l'arbre EDO Let Eo_xenv&=6 ! FTEXT dans l'arbre EDO Let Eo_com&=7 ! BUTTON dans l'arbre EDO Let Eo_xcom&=8 ! FTEXT dans l'arbre EDO Let Eo_wait&=9 ! BUTTON dans l'arbre EDO Let Eo_xwait&=10 ! FTEXT dans l'arbre EDO Let Eo_cnx&=11 ! BUTTON dans l'arbre EDO Let Eo_dcn&=12 ! BUTTON dans l'arbre EDO Let Eo_rec&=13 ! BUTTON dans l'arbre EDO Let Eo_xrec&=14 ! FTEXT dans l'arbre EDO Let Eo_ent&=15 ! BUTTON dans l'arbre EDO Let Eo_xent&=16 ! FTEXT dans l'arbre EDO Let Eo_yent&=17 ! BUTTON dans l'arbre EDO Let Eo_sim&=18 ! BUTTON dans l'arbre EDO Let Eo_op&=19 ! BUTTON dans l'arbre EDO Let Eo_ann&=20 ! BUTTON dans l'arbre EDO ' Let Eos&=36 ! Formulaire/Dialogue ' Let Entr&=37 ! Formulaire/Dialogue Let St_id&=2 ! BUTTON dans l'arbre ENTR Let St_txt&=3 ! FTEXT dans l'arbre ENTR Let St_ok&=4 ! BUTTON dans l'arbre ENTR ' Let Mclav&=38 ! Formulaire/Dialogue Let Dk_cf&=1 ! BOXTEXT dans l'arbre MCLAV Let Dk_so&=2 ! BOXTEXT dans l'arbre MCLAV Let Dk_an&=3 ! BOXTEXT dans l'arbre MCLAV Let Dk_re&=4 ! BOXTEXT dans l'arbre MCLAV Let Dk_rp&=5 ! BOXTEXT dans l'arbre MCLAV Let Dk_cl&=6 ! BOXCHAR dans l'arbre MCLAV Let Dk_ap&=7 ! BOXTEXT dans l'arbre MCLAV Let Dk_gu&=8 ! BOXTEXT dans l'arbre MCLAV Let Dk_co&=9 ! BOXTEXT dans l'arbre MCLAV Let Dk_su&=10 ! BOXTEXT dans l'arbre MCLAV Let Dk_en&=11 ! BOXTEXT dans l'arbre MCLAV Let Dk_rec&=12 ! BOXTEXT dans l'arbre MCLAV Let Dk_arr&=13 ! BOXTEXT dans l'arbre MCLAV Let Dk_ava&=14 ! BOXTEXT dans l'arbre MCLAV Let Dk_pla&=15 ! BOXTEXT dans l'arbre MCLAV Let Dk_pau&=16 ! BOXTEXT dans l'arbre MCLAV Let Dk_sto&=17 ! BOXTEXT dans l'arbre MCLAV Let Dk_txt&=18 ! BOXTEXT dans l'arbre MCLAV Let Dk_sz&=19 ! BOXCHAR dans l'arbre MCLAV ' Let Install&=39 ! Formulaire/Dialogue Let Cf_1st&=3 ! STRING dans l'arbre INSTALL Let Cf_up&=11 ! BUTTON dans l'arbre INSTALL Let Cf_dw&=12 ! BUTTON dans l'arbre INSTALL Let Cf_1&=14 ! BUTTON dans l'arbre INSTALL Let Cf_2&=15 ! BUTTON dans l'arbre INSTALL Let Cf_ok&=16 ! BUTTON dans l'arbre INSTALL ' Let Fnt&=40 ! Formulaire/Dialogue Let Fnt_box&=4 ! BOX dans l'arbre FNT Let Fnt_up&=5 ! BUTTON dans l'arbre FNT Let Fnt_dw&=6 ! BUTTON dans l'arbre FNT Let Fnt_ann&=7 ! BUTTON dans l'arbre FNT Return ' ' Agh.. ' Les boites menu doivent avoir une taille inf‚rieure … un certain quota ' lorsque Work_out(1)<=200 ' Si c'est le cas, on "compacte" les menus en supprimant des entr‚es non indispensables Procedure Verify_menu ' If Work_out(1)<=238 ! ProblŠme ' ' Menu Fichier: 2 entr‚es en moins Vmenu(Adr%(43),M_f3&-1,M_c_q&,M_f3b&-1,M_f3b&+1) ! supprimer entr‚e menu virtuellement Vmenu(Adr%(10),M_f3&-1,M_c_q&,M_f3b&-1,M_f3b&+1) ! supprimer entr‚e menu virtuellement Vmenu(Adr%(43),M_f3&-1,M_c_q&,M_f3b&-1,M_run1&+1) ! supprimer entr‚e menu virtuellement Vmenu(Adr%(10),M_f3&-1,M_c_q&,M_f3b&-1,M_run1&+1) ! supprimer entr‚e menu virtuellement ' ' Menu Options Vmenu(Adr%(43),M_c_n&-1,M_em_sv&,M_c_t&+1,M_c_p&+1) Vmenu(Adr%(10),M_c_n&-1,M_em_sv&,M_c_t&+1,M_c_p&+1) Vmenu(Adr%(43),M_c_n&-1,M_em_sv&,M_c_t&+1,M_em_col&+1) Vmenu(Adr%(10),M_c_n&-1,M_em_sv&,M_c_t&+1,M_em_col&+1) Vmenu(Adr%(43),M_c_n&-1,M_em_sv&,M_c_t&+1,M_em_mem&+1) Vmenu(Adr%(10),M_c_n&-1,M_em_sv&,M_c_t&+1,M_em_mem&+1) Vmenu(Adr%(43),M_c_n&-1,M_em_sv&,M_c_t&+1,M_em_sv&) Vmenu(Adr%(10),M_c_n&-1,M_em_sv&,M_c_t&+1,M_em_sv&) Vmenu(Adr%(43),M_c_n&-1,M_em_sv&,M_c_t&+1,M_em_mod&) Vmenu(Adr%(10),M_c_n&-1,M_em_sv&,M_c_t&+1,M_em_mod&) Vmenu(Adr%(43),M_c_n&-1,M_em_sv&,M_c_t&+1,M_em_col&) Vmenu(Adr%(10),M_c_n&-1,M_em_sv&,M_c_t&+1,M_em_col&) ' ' Endif ' Return ' Interne … Menu_verify: Adresse menu, objet box, dernier objet, ' cible entr‚e, objet … d‚placer Procedure Vmenu(Adr%,B&,L&,E&,O&) Local A& ' ' D‚caler les autres entr‚es For A&=L& Downto O&+1 Ob_y(Adr%,A&)=Ob_y(Adr%,A&)-Ob_h(Adr%,O&) Next A& ' ' Changer taille boite menu Ob_h(Adr%,B&)=Ob_h(Adr%,B&)-Ob_h(Adr%,O&) ' ' D‚placer objet sur "cible" Ob_x(Adr%,O&)=Ob_x(Adr%,E&) Ob_y(Adr%,O&)=Ob_y(Adr%,E&) ' ' Copier attributs de la ------- Ob_flags(Adr%,O&)=Ob_flags(Adr%,E&) Ob_state(Adr%,O&)=Ob_state(Adr%,E&) ' ' Effacer objet Char{Ob_spec(Adr%,O&)}="" ' Return ' ' Procedure Getcol Local A$,B$ ' ~Shel_get(4096,A$) Repeat B$=@Flin$(A$) If Left$(B$,2)="#Q" ' #Q xx XX yy YY zz ZZ minuscules: trame-col pour ST BAS,MOY,HAUT Select Plans& Case 1 Dcol&=Val("$"+Mid$(B$,5,1)) Dstyl&=Val("$"+Mid$(B$,4,1)) Case 2 Dcol&=Val("$"+Mid$(B$,11,1)) Dstyl&=Val("$"+Mid$(B$,10,1)) Case 4 To Dcol&=Val("$"+Mid$(B$,17,1)) Dstyl&=Val("$"+Mid$(B$,16,1)) Endselect Clr A$ Endif Until Len(A$)=0 ' Return ' ' Function Crc82(E$) Local A& Local S& Clr S& For A&=1 To Len(E$) S&=Byte(A&+Len(E$)+S&+Asc(Mid$(E$,A&,1))) Next A& Return S& Endfunc ' ' Procedure Rsc_cut ' Let M_newtitle&=3 ! TITLE dans l'arbre MNU_EDITI Let M_ed_a_f&=6 ! STRING dans l'arbre MNU_EDITI ' ' Ohide(1,Rsc_num&) ! TEXT dans l'arbre OPTIONS ' ' Ob_state(Adr%(22),En_min&)=Bclr(Ob_state(Adr%(22),En_min&),0) ' Ob_state(Adr%(22),En_scr&)=Bset(Ob_state(Adr%(22),En_scr&),0) ' Return Procedure Hide(X&,N&) ~Menu_ienable(Adr%(43),N&,0) ' ~Menu_ienable(Adr%(X&+10),N&,0) ' Ob_state(Adr%(X&+10),N&)=Bset(Ob_state(Adr%(X&+10),N&),1) Return Procedure Ohide(X&,N&) If N&>0 Ob_state(Adr%(X&),N&)=Bset(Ob_state(Adr%(X&),N&),3) Ob_flags(Adr%(X&),N&)=Bclr(Ob_flags(Adr%(X&),N&),1) Ob_flags(Adr%(X&),N&)=Bclr(Ob_flags(Adr%(X&),N&),2) Ob_flags(Adr%(X&),N&)=Bclr(Ob_flags(Adr%(X&),N&),6) Ob_flags(Adr%(X&),N&)=Bset(Ob_flags(Adr%(X&),N&),7) Else ' print "Erreur" ' ~Inp(2) Endif 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%(21),Pr_txt&)}}=E$ Endif If Set_progress! Wmove(0,0,0,0,Rx&(21),Ry&(21),Rw&(21),Rh&(21)) Ob_h(Adr%(21),Pr_sl&)=Ob_h(Adr%(21),Pr_box&)-1 Ob_w(Adr%(21),Pr_sl&)=0 ~@Form_exdo(21,-2) ' ~Objc_draw(Adr%(21),0,&HFF,Rx&(21),Ry&(21),Rw&(21),Rh&(21)) Set_progress!=False ' Else if P&<0 ! un autre slide Ob_w(Adr%(21),Pr_sl&)=0 ~Objc_draw(Adr%(21),0,&HFF,Rx&(21),Ry&(21),Rw&(21),Rh&(21)) Endif If Len(E$)>0 ~Objc_draw(Adr%(21),Pr_txt&,&HFF,Rx&(21),Ry&(21),Rw&(21),Rh&(21)) Endif Ob_w(Adr%(21),Pr_sl&)=(P&*Ob_w(Adr%(21),Pr_box&))\100 ~Objc_draw(Adr%(21),Pr_sl&,&HFF,Rx&(21),Ry&(21),Rw&(21),Rh&(21)) Gosub Defmouse(2) Else If Set_progress!=False Ob_w(Adr%(21),Pr_sl&)=Ob_w(Adr%(21),Pr_box&) ~Objc_draw(Adr%(21),Pr_box&,&HFF,Rx&(21),Ry&(21),Rw&(21),Rh&(21)) N&=@Wind_update01(-1) ~@Wind_update01(0) Set_progress!=True ' ~Form_dial(3,0,0,0,0,Rx&(21),Ry&(21),Rw&(21),Rh&(21)) ~@Form_exdo(21,-3) Gosub W_rdexe Wmove(Rx&(21),Ry&(21),Rw&(21),Rh&(21),0,0,0,0) ~@Wind_update01(N&) Endif Endif Return ' ' Protection Function Unchar323(N&) ! EN FAIT 16 att! Select N& Case 65 To 90 Return And(N&-65,&X1111) Case 48 To Return And(N&-48+26,&X1111) Endselect Return 0 Endfunc ' ' Function Upcase(Key&) $F% $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_infos& ! Info Return -9 Case M_finfo& ! Info fichier Return 194 Case M_fdel& ! Delete file Return 195 Case M_exe& ! Exec file Return 333 Case M_go& Return 347 Case M_em_dsk& Return 348 ' Case M_trn& Return 344 Case M_dwn& Return 345 Case M_upl& Return 346 ' Case M_run1& To M_run4& Return 334+N&-M_run1& ' Case M_c_q& ! Quit Sweetel Return 196 ' Case M_som& Return 20510 ' Case M_xt& ! sauver txt Return 20506 ' Case M_f9& ! Return 195 Case M_f5& ! Capturer Return 191 Case M_c_e& ! Send Return 405 Case M_c_e2& ! Send Return 305 Case M_c_go& ! Aller ….. Return 349 Case M_a_e& ! ..clavier Return -146 Case M_f3& ! charger Return 187 Case M_f3b& ! autre Return 287 Case M_f4& ! Return 188 ' 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 511 Case M_icn& ! Smaller Return 11 Case M_c_w& ! OpenAll Return 23 Case M_c_t& ! ..‚mul Return 20 Case M_texte& ! Set texte color & effetx Return -84 Case M_c_p& ! Options Return -16 ' Default ' ' Menu emul ' Select N&-M_first&+M_ed_a_f& Select N& Case M_em_fac& Return 508 ! factureur Case M_em_equ& ! basculer draw/‚mul Return 20147 Case M_em_cal& Return 20192 Case M_em_t& Return 20193 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 Case M_em_cnx& Return 20444 Case M_em_mod& Return 20446 Case M_em_sv& Return 20447 Case M_em_mem& Return 20448 Case M_em_pho& Return 20449 Case M_em_pad& Return 20450 Case M_em_f4& Return 20190 Endselect ' 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,Errn40$) Endif ' If Not Set_escape! ! Ne pas quitter sans effacer les champs Erase Rx&(),Ry&(),Rw&(),Rh&(),Adr%() ' ' I/O Erase Rs&(),Rn$() Endif Return ' Function Menu_oqp $F% Local E&,Flag! ' If Menu_adr%>0 If Not Accessoire! Flag!=False If (Not Set_end!) And Menu_hlp! For E&=M_1st& To M_ii& If Btst(Ob_state(Menu_adr%,E&),0) Flag!=True Endif Next E& If Flag! Aff_oqp Endif Endif Return Flag! Else Return False Endif Else Return False Endif ' Endfunc Procedure Aff_oqp Local N&,X& Local E$ ' Clr E$ N&=M_ii& X&=M_run1&+3 Repeat Inc N& Select Ob_type(Menu_adr%,N&) Case 28 ! string If Btst(Ob_state(Menu_adr%,N&),0) Select N& Case M_infos& E$="Informations" Case M_f3& E$="Charger un fichier dans le magn‚to" Case M_f4& E$="Sauver le buffer magn‚to" Case M_xt& E$="Sauver le magn‚to sous forme ASCII" Case M_f3b& E$="Charger un texte ascii" Case M_finfo& E$="Informations sur un fichier" Case M_fdel& E$="Effacer un fichier" Case M_run1& To X& E$="Lancer application #"+Str$(N&-M_run1&+1) Case M_go& E$="Lancer une application" Case M_som& E$="Mettre Swiftel en sommeil" Case M_c_q& E$="Quitter Swiftel photo" Case M_f5& E$="D‚marrer enregistrement magn‚to" Case M_c_e& E$="Voir le magn‚to" Case M_c_go& E$="Page du magn‚to" Case M_c_e2& E$="Envoi vers le modem" Case M_a_e& E$="Envoyer sous forme ascii" Case M_efface& E$="Effacer l'‚cran du minitel" Case M_c_rr& E$="Initialiser le modem" Case M_a_r& E$="Synchroniser le minitel" Case M_dwn& E$="Recevoir un fichier" Case M_upl& E$="Envoyer un fichier" Case M_em_cal& E$="Appeler un num‚ro" Case M_em_t& E$="Clavier minitel" Case M_em_f4& E$="Macros-commandes" Case M_em_cnx& E$="Connect‚?" Case M_em_pad& E$="Compatibilit‚ PAD-X3?" Case M_em_cls& E$="Effacer ‚cran Swiftel" Case M_em_on& E$="Activer curseur" Case M_em_off& E$="D‚sactiver curseur" Case M_em_40& E$="Passer en 40 colonnes" Case M_em_80& E$="Passer en 80 colonnes" Case M_em_in& E$="R‚initialiser l'‚mulateur" Case M_c_n& E$="Prochaine fenˆtre" Case M_c_f& E$="Pleine page" Case M_c_f2& E$="Plein ‚cran" Case M_icn& E$="Iconifier la fenˆtre" Case M_c_k& E$="Fermer la fenˆtre" Case M_c_w& E$="Ouvrir toute les fenˆtres" Case M_c_t& E$="Voir fenˆtre d'‚mulation" Case M_c_p& E$="Options g‚n‚rales" Case M_em_dsk& E$="Options du bureau" Case M_em_equ& E$="Options de l'‚mulateur" Case M_em_pho& E$="Options photo" Case M_trn& E$="Options transfert BBS" Case M_exe& E$="Options applications" Case M_em_mod& E$="Options chaines modem" Case M_em_ca& E$="Options m‚moire cache ‚mulateur" Case M_em_col& E$="Options style et couleurs ‚mulateur" Case M_em_mem& E$="Informations m‚moire" Case M_em_sv& E$="Sauvegarder les options" Default E$="" Endselect Exit if Len(E$)>0 Endif Endselect Until Btst(Ob_flags(Menu_adr%,N&),5) ! lastob ' If Len(E$)>0 E$=" "+E$ If E$=Men_e$ If Men_xp&>0 ! si scrolling @Print(Chr$(27)+"Y"+" "+Chr$(31+Men_x&)+Mid$(Men_e$+Space$(Men_w&),Men_xp&,Men_w&)) Inc Men_xp& If Men_xp&>Len(Men_e$)-Men_w&+2 Men_xp&=1 Endif Endif Else If Men_w&>0 @Print(Chr$(27)+"Y"+" "+Chr$(31+Men_x&)+Space$(Men_w&)) Endif ' Men_e$=E$ Men_x&=W_desk&\X_char&-Len(Men_e$) If Men_x&=>62 ! ok assez de place If Men_x&=>64 Sub Men_x&,2 Endif Men_xp&=0 Men_w&=Len(Men_e$) Else Men_x&=60 Men_xp&=1 ! scrolling Men_w&=W_desk&\X_char&-Men_x& ! largeur scrolling Endif @Print(Chr$(27)+"Y"+" "+Chr$(31+Men_x&)+Left$(Men_e$,Men_w&)) Endif Else If Men_x&>0 @Print(Chr$(27)+"Y"+" "+Chr$(31+Men_x&)+Space$(Men_w&)) Clr Men_e$,Men_x&,Men_w&,Men_xp& Endif Endif Return ' 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& Local P& Local X$,A$ ' 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$+"]") ~@Titlew(Wdial&,Char{Ob_spec(Adr%(D%),2)}) Endif Else Ob_flags(Adr%(D%),2)=Bclr(Ob_flags(Adr%(D%),2),7) Endif Endif Else ~@Titlew(Wdial&,Name$) Endif ' If Wd_set! ' If B%=-3! restore ~@Wind_close(Wdial&) ' Set_wdial!=False If Menu_adr%>0 N&=M_f3&-1 Ob_state(Menu_adr%,M_infos&)=Bclr(Ob_state(Menu_adr%,M_infos&),3) Repeat Inc N& Select Ob_type(Menu_adr%,N&) Case 28 If Left$(Char{Ob_spec(Menu_adr%,N&)},1)<>"-" Ob_state(Menu_adr%,N&)=Bclr(Ob_state(Menu_adr%,N&),3) Endif Endselect Until Btst(Ob_flags(Menu_adr%,N&),5) ! lastob Gosub Test_menu ! retester menu Endif ' Else ' If Not Wopen!(Wdial&) ' Set_wdial!=True If Menu_adr%>0 N&=M_f3&-1 Ob_state(Menu_adr%,M_infos&)=Bset(Ob_state(Menu_adr%,M_infos&),3) Repeat Inc N& Select Ob_type(Menu_adr%,N&) Case 28 If Left$(Char{Ob_spec(Menu_adr%,N&)},1)<>"-" Ob_state(Menu_adr%,N&)=Bset(Ob_state(Menu_adr%,N&),3) Endif Endselect Until Btst(Ob_flags(Menu_adr%,N&),5) ! lastob Endif ' 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&)) ' ' A!=Effect! ' Effect!=False ' ~Wind_calc(1,Wflag%(Wdial&),W_ex&(Wdial&),W_ey&(Wdial&),W_ew&(Wdial&),W_eh&(Wdial&),W_ix&(Wdial&),W_iy&(Wdial&),W_iw&(Wdial&),W_ih&(Wdial&)) W_attrw&(Wdial&)=W_ew&(Wdial&)-W_iw&(Wdial&) W_attrh&(Wdial&)=W_eh&(Wdial&)-W_ih&(Wdial&) ' ' *** If Ob_w(Adr%(Wd_id&),0)+W_attrw&(Wdial&)>W_desk&\3 Or Ob_h(Adr%(Wd_id&),0)+W_attrh&(Wdial&)-Wd_incy&>W_desk& ' Wflag%(Wdial&)=&X100111111101111 ' Else ' Wflag%(Wdial&)=&X100000000001011 ' Endif ' Wset_x(Wdial&,Rx&(Wd_id&)) Wset_y(Wdial&,Ry&(Wd_id&)) Wset_w(Wdial&,Ob_w(Adr%(Wd_id&),0)+W_attrw&(Wdial&)) Wset_h(Wdial&,Ob_h(Adr%(Wd_id&),0)+W_attrh&(Wdial&)-Wd_incy&) ' ~@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 ' If Set_mouse&=2 ! pas de souris en "abeille" @Defmouse(0) Endif 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&) ' If Wmenu&(0)=Wm_topped& Select @Windex(Wmenu&(3)) ! Index de fenˆtre? Case Wdial& Case 0 To 6 If @Xfirstw<>Wdial& Wmenu&(3)=Whandle&(Wdial&) Else Evnmnt&=Bclr(Evnmnt&,4) ! alors court circuiter! Endif 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) ' Default Clr X$ Select Key& Case 225,3,27 ! undo X$="ANNUL" Case 200 ! h X$=Chr$(1) Case 208 ! b X$=Chr$(2) Case 203 ! g X$=Chr$(4) Case 205 ! d X$=Chr$(3) Case 19,115 ! S,^S X$="SAUVE" Default ' X$=Upper$(Chr$(Key&)) Clr X$ Endselect ' A&=0 Do ' A&=Ob_next(Adr%(Wd_id&),A&) Inc A& If Ob_type(Adr%(Wd_id&),A&)=26 A$=Upper$(Char{Ob_spec(Adr%(Wd_id&),A&)}) If Left$(A$,Len(X$))=X$ Evnmnt&=Bset(Evnmnt&,1) ~Objc_offset(Adr%(Wd_id&),A&,Mx&,My&) Mk&=1 Endif Endif Loop until Btst(Ob_flags(Adr%(Wd_id&),A&),5) If Mk&<>1 If X$="ANNUL" ~@Wind_close(Wdial&) Endif Endif ' 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) Desel(Wd_id&,O&) ~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) Desel(Wd_id&,A&) ~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) P&=@Mousek ! si=0 alors ok @Caremouse ' Else if Btst(Ob_flags(Adr%(Wd_id&),O&),3) ! editable 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) Desel(Wd_id&,A&) 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&) Or P&=0 A%=O& Else ' Ob_state(Adr%(Wd_id&),O&)=Bclr(Ob_state(Adr%(Wd_id&),O&),0) Desel(Wd_id&,O&) 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& ' 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%),Rx&(D%)+Rw&(D%)\2,Ry&(D%)+Rh&(D%)\2,1,1) 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(Rx&(D%)+Rw&(D%)\2,Ry&(D%)+Rh&(D%)\2,1,1,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(Rx&(D%),Ry&(D%),Rw&(D%),Rh&(D%),X%-X2%,Y%-Y2%,Rw&(D%),Rh&(D%)) ' 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) Desel(D%,Z%) ~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) Desel(D%,Z%) 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 ' ' $P< Procedure Desel(T&,O&) Ob_state(Adr%(T&),O&)=Bclr(Ob_state(Adr%(T&),O&),0) Return Procedure Zdesel(T&,O&) ~Objc_change(Adr%(T&),O&,0,Rx&(T&),Ry&(T&),Rw&(T&),Rh&(T&),Bset(Ob_state(Adr%(T&),O&),0),0) Return Procedure Rflags(T&,O&,X&,Flag!) If Flag! Ob_flags(Adr%(T&),O&)=Bset(Ob_flags(Adr%(T&),O&),X&) Else Ob_flags(Adr%(T&),O&)=Bclr(Ob_flags(Adr%(T&),O&),X&) Endif Return $P> ' Function Dinput$(A$,E$,Var X&) Local A& Char{Ob_spec(Adr%(24),St_id&)}=A$ Char{{Ob_spec(Adr%(24),St_txt&)}}=E$ Exdo!=True A&=Byte(@Form_exdo(24,0)) Desel(24,A&) If A&=St_ok& X&=-1 E$=Char{{Ob_spec(Adr%(24),St_txt&)}} Else X&=0 Clr E$ Endif ~@Form_exdo(24,-3) Return E$ Endfunc ' ' Show box/hide Procedure Fmshow(E$) If Dim?(Adr%()) Exdo!=True 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 Endif Return Procedure Fmhide If Dim?(Adr%()) ~Form_dial(3,0,0,0,0,Rx&(33),Ry&(33),Rw&(33),Rh&(33)) ' *~@Form_exdo(33,-3) ! restaurer Gosub W_rdexe Endif 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 ' ' ' Infos pour menu & drcs Procedure Menu.info(E$) ~@Infow(1,E$) ~@Infow(4,E$) ' Menu_time!=False ' If Not Wopen!(1) ' Gosub Rqshow(E$) ' Endif Return ' Infos ‚mulateur Procedure Eminfo(E$) Local A& ' If Len(E$)>0 If Left$(E$,1)="#" E$=Mid$(E$,2) Outlog(E$) Endif ' ' @Lprintl(E$) ' print At(1,1);E$,,,, ~@Infow(4,E$) ' ' If Wopen!(1) ' If Not Accessoire! ' Comp.info("","Options..") ' Endif ' Endif ' 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 0 If Wopen!(4) Clip(W_ix&(4),W_iy&(4),W_iw&(4)-1,W_ih&(4)-1) @Deffillcol(0) @Graphmode(1) 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&+2)*Eccsizey&+(1+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 Endif Else If 0 @Sweety_text Deftext 1 For A&=0 To 3 @Wtext(4,Emx&,Emy&+(Vmax_y&+2)*Eccsizey&+(1+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 Endif Return ' Infos techniqus, d‚buggage Procedure Emtechinfo(E$) If Inftech! Eminfo(E$) Comp.info("G",E$) Endif Return ' Info erreur, ‚crit aussi sur LOG Procedure Err.info(E$) @Eminfo(E$) Outlog("! "+E$) 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&) Clip(X&,Y&,W&,H&) ! Clipping! If @Tstwork(Index&) ! Non smaller Draw(Index&,X&,Y&,W&,H&) Else @Sm_draw(Index&,X&,Y&,W&,H&) Endif Clip_off 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 W&,H& Local A!,B! Local T$,E$ Local X2&,Y2& Local A&,B&,C&,D&,E& Local N& ' ~Objc_offset(Adr%(5),Rsc_box&,X2&,Y2&) Exdo!=True @W_rdexe ' "Deftail(Font_tail&) Clip(X2&,Y2&,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 ' ' Gosub Xsel(Rsc_stu1&,Flag!) ' Gosub Xsel(Rsc_std1&,Flag!) ' Gosub Xsel(Rsc_stu2&,Flag!) ' Gosub Xsel(Rsc_std2&,Flag!) ' Gosub Xtsel(Dm_1&,Not Flag!) Gosub Xtsel(Dm_2&,Not Flag!) Gosub Xtsel(Dm_3&,Not Flag!) Gosub Xtsel(Dm_m1&,Not Flag!) Gosub Xtsel(Dm_p1&,Not Flag!) Gosub Xtsel(Dm_m2&,Not Flag!) Gosub Xtsel(Dm_p2&,Not Flag!) ' ~Vqt_name(Font&,E$) ! nom Ob_flags(Adr%(5),Rsc_id&)=Bset(Ob_flags(Adr%(5),Rsc_id&),6) Char{{Ob_spec(Adr%(5),Rsc_id&)}}=Left$(E$,30) ' If Flag! Emul_text(0) 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&) Pbox X2&+16,Y2&+16,X2&+Ob_w(Adr%(5),Rsc_box&)-16,Y2&+Ob_h(Adr%(5),Rsc_box&)-16 ' Text x2+X%,y2+Ob_h(Adr%(5),Rsc_box&)-Z%-16,"ABcd" Text X2&,Y2&+Ob_h(Adr%(5),Rsc_box&)-Z%-16,"ABcd" @Showm W&=Eccsizex&*40 H&=Eccsizey&*25 ' X2%=Eccsizex& ! pur‚e cette routine est crade.. Y2%=Eccsizey& ' Do ' W&=Max(W&,40*X2%) H&=Max(H&,25*Y2%) W&=Min(W&,40*128) H&=Min(H&,25*128) ' Char{{Ob_spec(Adr%(5),Dm_w&)}}=Str$(W&) Char{{Ob_spec(Adr%(5),Dm_h&)}}=Str$(H&) ~Objc_draw(Adr%(5),Dm_w&,7,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) ~Objc_draw(Adr%(5),Dm_h&,7,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) ' If Set_drfnt! Char{Ob_spec(Adr%(5),Dm_fnt&)}="Annuler la fonte DRCS" Else Char{Ob_spec(Adr%(5),Dm_fnt&)}="Charger une autre fonte" Endif ~Objc_draw(Adr%(5),Dm_fnt&,7,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) ' If Flag! Clip(X_desk&,Y_desk&,W_desk&,H_desk&) If Not Nice! Graphmode 3 Box X_desk&+1,Y_desk&+1,X_desk&+40*X2%-2,Y_desk&+25*Y2%-2 Defline 1,5 Box X_desk&,Y_desk&,X_desk&+W&-1,Y_desk&+H&-1 Defline 1,1 Graphmode 1 Endif Endif ' 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) ' If Flag! If Not Nice! Graphmode 3 Box X_desk&+1,Y_desk&+1,X_desk&+40*X2%-2,Y_desk&+25*Y2%-2 Defline 1,5 Box X_desk&,Y_desk&,X_desk&+W&-1,Y_desk&+H&-1 Defline 1,1 Graphmode 1 Endif Clip(X2&,Y2&,Ob_w(Adr%(5),Rsc_box&),Ob_h(Adr%(5),Rsc_box&)) Endif ' $S& Select Byte(N%) Case Rsc_stok& Exit if True ' Case 0,1 ! 0 N%=-1 Exit if True ' Case Dm_fnt& ~@Form_exdo(5,-3) ' If Set_drfnt! Set_drfnt!=False Rafale!=True Else Do F$=@Fsel$("\*.SFD",Set_path$+"SYSTEME\FONTES\","Fonte Swiftel DRCS") If Len(F$)>0 N&=Rinstr(F$,"\") If N&>0 F$=Mid$(F$,N&+1) Endif If @Exist(Set_path$+"SYSTEME\FONTES\"+F$) Fileh&=@Fopen(F$,0) If Fileh&>0 If @Fread$(Fileh&,8)="SWT2DRCS" Drfnt_name$=F$ ' Set_drfnt!=True Rafale!=True Drfnt_init Drcs_uninit Drcs_init Cache_uninit Cache_init ' Exit if True Else ~@Form_alert(1,"[1][Mauvais format de fonte|(DRCS/Sweetel2 seulement)][Annuler]") Endif ~@Tsterr(@Fclose(Fileh&)) Endif Else ~@Form_alert(1,"[1][Mauvais chemin |(seulement SYSTEME\FONTES)|ou fichier introuvable!][Annuler]") Endif Else Exit if True Endif Loop Endif ' ' ~@Form_exdo(44,-3) Exdo!=True ~@Form_exdo(5,-2) ' ' Copie de.. @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&) Pbox X2&+16,Y2&+16,X2&+Ob_w(Adr%(5),Rsc_box&)-16,Y2&+Ob_h(Adr%(5),Rsc_box&)-16 Text X2&,Y2&+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_id& ~@Form_exdo(5,-3) ' B&=Ob_h(Adr%(44),Fnt_box&) B&=B&\4 Exdo!=True ~@Form_exdo(44,-2) ~Objc_offset(Adr%(44),Fnt_box&,X2&,Y2&) Clip(X2&,Y2&,Ob_w(Adr%(44),Fnt_box&),Ob_h(Adr%(44),Fnt_box&)) C&=Font& D&=Font& E&=X% Contrl(0)=12 Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=19 Vdisys Get_csize Get_cdec Do ~Objc_draw(Adr%(44),Fnt_box&,255,Rx&(44),Ry&(44),Rw&(44),Rh&(44)) Set_font(C&) Text X2&,Y2&+19,"ABcd" Set_font(C&+1) Text X2&,Y2&+B&*1+19,!Chr$(Mkl$(Mks$( Set_font(C&+2) Text X2&,Y2&+B&*2+19,"ABcd" Set_font(C&+3) Text X2&,Y2&+B&*3+19,"ABcd" ' A&=Byte(@Form_exdo(44,0)) Select A& Case Fnt_up& Set_font(Font&-1) Set_font(Font&-1) Set_font(Font&-1) Set_font(Font&-1) C&=Font& Case Fnt_dw& Set_font(Font&+1) Set_font(Font&+1) Set_font(Font&+1) Set_font(Font&+1) C&=Font& Case Fnt_box& Exit if True Default Exit if True Endselect Loop X%=E& Contrl(0)=12 Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=X% Vdisys If A&=Fnt_box& Set_font(C&+(@Mousey-Y2&)\B&) Else Set_font(D&) Endif ~Objc_offset(Adr%(5),Rsc_box&,X2&,Y2&) Clip(X2&,Y2&,Ob_w(Adr%(5),Rsc_box&),Ob_h(Adr%(5),Rsc_box&)) ~@Form_exdo(44,-3) ' Exdo!=True ~@Form_exdo(5,-2) ' ' Copie de.. @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&) Pbox X2&+16,Y2&+16,X2&+Ob_w(Adr%(5),Rsc_box&)-16,Y2&+Ob_h(Adr%(5),Rsc_box&)-16 Text X2&,Y2&+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_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 ~Vqt_name(Font&,E$) ! nom Char{{Ob_spec(Adr%(5),Rsc_id&)}}=Left$(E$,28) ~Objc_draw(Adr%(5),Rsc_id&,255,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) ' Case Rsc_stup& X%=Min(255,X%+1) Case Rsc_stdw& X%=Max(2,X%-1) 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 Or Flag! Get_csize If Ccsizex&=X2% And Ccsizey&=Y2% ! ca ne sert … rien! If X%>99 If A%=1 X%=Y% Endif 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&) Pbox X2&+16,Y2&+16,X2&+Ob_w(Adr%(5),Rsc_box&)-16,Y2&+Ob_h(Adr%(5),Rsc_box&)-16 Text X2&,Y2&+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&) ' Pbox x2+16,y2+16,x2+Ob_w(Adr%(5),Rsc_box&)-16,y2+Ob_h(Adr%(5),Rsc_box&)-16 ' Text x2,y2+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 Dm_p1& W&=W&+40 Case Dm_p2& H&=H&+25 Case Dm_m1& W&=W&-40 Case Dm_m2& H&=H&-25 ' Case Dm_1&,Dm_2&,Dm_3& ~Objc_change(Adr%(5),Dm_1&,0,Rx&(5),Ry&(5),Rw&(5),Rh&(5),Bclr(Ob_state(Adr%(5),Byte(N%)),0),1) ~Objc_change(Adr%(5),Dm_2&,0,Rx&(5),Ry&(5),Rw&(5),Rh&(5),Bclr(Ob_state(Adr%(5),Byte(N%)),0),1) ~Objc_change(Adr%(5),Dm_3&,0,Rx&(5),Ry&(5),Rw&(5),Rh&(5),Bclr(Ob_state(Adr%(5),Byte(N%)),0),1) ~Objc_change(Adr%(5),Byte(N%),1,Rx&(5),Ry&(5),Rw&(5),Rh&(5),Bclr(Ob_state(Adr%(5),Byte(N%)),0),1) ~Objc_draw(Adr%(5),Dm_1&,7,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) ~Objc_draw(Adr%(5),Dm_2&,7,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) ~Objc_draw(Adr%(5),Dm_3&,7,Rx&(5),Ry&(5),Rw&(5),Rh&(5)) ' Select Byte(N%) Case Dm_1& W&=X2%*40 H&=Y2%*25 W&=Max(W&,H&) H&=W& Case Dm_2& W&=X2%*40 H&=Y2%*25 ' Case Dm_3& Endselect ' 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) @Rd_all(A%,W_ix&(A%),W_iy&(A%),W_iw&(A%),W_ih&(A%)) Endif Next A% @Showm ' If Flag! ' Gosub Emul_uninit ' ' Ncach&=65536/(@Bitlen(Ccsizex&,Ccsizey&)+4) ' Ncach&=Max(16,Ncach&) ' Ncach&=Min(4096,Ncach&) ' Gosub Emul_init ' Endif Gosub Defmouse(0) Endif ' If Flag! ' If A! ' ~@Wind_open(4) ' ' @Rd_all(4,W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) ' Endif ' Endif If D%<>Colg& Or E%<>Col1& If Not B! For X%=Nbr_idxw& Downto 0 If Wopen!(X%) @Rd_all(X%,W_ix&(X%),W_iy&(X%),W_iw&(X%),W_ih&(X%)) Endif Next X% Endif @Showm Endif ' Else ! if Flag! ' Efont&=Font& Vdt_tail&=X% If 0 @Hidem ' 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) ' ' ' TextX/Y : Taille cellule car - EccsizeX/Y: Taille cellule VIDOTEX Textx&=Eccsizex& Texty&=Eccsizey& Eccsizex&=W&\40 Eccsizey&=H&\25 ' Swcol$=Left$(Swcol$,96) @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 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 Xsel(A&,Flag!) If Flag! Ob_state(Adr%(5),A&)=Bset(Ob_state(Adr%(5),A&),3) Ob_flags(Adr%(5),A&)=Bclr(Ob_flags(Adr%(5),A&),2) Ob_flags(Adr%(5),A&)=Bclr(Ob_flags(Adr%(5),A&),6) Else Ob_state(Adr%(5),A&)=Bclr(Ob_state(Adr%(5),A&),3) Ob_flags(Adr%(5),A&)=Bset(Ob_flags(Adr%(5),A&),2) Ob_flags(Adr%(5),A&)=Bset(Ob_flags(Adr%(5),A&),6) Endif Return Procedure Xtsel(A&,Flag!) If Flag! Ob_state(Adr%(5),A&)=Bset(Ob_state(Adr%(5),A&),3) Ob_flags(Adr%(5),A&)=Bclr(Ob_flags(Adr%(5),A&),6) Else Ob_state(Adr%(5),A&)=Bclr(Ob_state(Adr%(5),A&),3) Ob_flags(Adr%(5),A&)=Bset(Ob_flags(Adr%(5),A&),6) 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))+$ And And And And Imp $ And > And Mks$( And ;1 To Maxfont& 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) If Not Set_escape! ! Ne pas quitter sans effacer les champs Erase Font&() Endif Return ' ' Procedure Nice_size(A&,B&) Local W&,H& ' Sub A&,Emx&+4 Sub B&,Emy&+Emy2&+4 ' ' If Nice! A&=Max((Vmax_x&+1)*2,A&) B&=Max((Vmax_y&+1)*2,B&) A&=((A&+1)\(Vmax_x&+1))*(Vmax_x&+1) B&=((B&+1)\(Vmax_y&+1))*(Vmax_y&+1) If Mod(A&,Vmax_x&+1)<>0 A&=(A&\(Vmax_x&+1))*(Vmax_x&+1) Endif If Mod(B&,Vmax_y&+1)<>0 B&=(B&\(Vmax_y&+1))*(Vmax_y&+1) Endif Eccsizex&=A&\(Vmax_x&+1) Eccsizey&=B&\(Vmax_y&+1) ' Gosub Cache_uninit If Eccsizex&*Eccsizey&=0 Outlog(" .. erreur interne #Nice_size/ECCXY_TST") Endif ' W&=Eccsizex& H&=Eccsizey& ' 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) ' ' ' ---------------------------------------- ' -----Copie de Emul_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) Texty&=Ptsout(3) ' Contrl(0)=117 ! Inquire Character Cell Width Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Vdisys ' Eccsizex&=Ptsout(0) Textx&=Ptsout(0) ' ' Etext&(4)=Eccsizey& ! taille txt, 4=sweet Etext&(4)=Texty& ! taille txt, 4=sweet ' For A&=0 To 3 Emul_text(A&) Contrl(0)=38 Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys ' Decalt&(A&)=Ptsout(1) ! d‚calage pour la taille A& Decalt&(A&)=Eccsizey&*(1-Btst(A&,0))-(Ptsout(3)-Ptsout(1)) ! d‚calage pour la taille A& Next A& Emul_text(0) ' ---------------------------------------- ' ' If Textx&*Texty&=0 ' ~@Form_alert(1,"[3][Erreur interne "+Str$(Textx&)+" "+Str$(Texty&)+"][Annuler]") ' Endif ' ' Gosub Field_max Gosub Cache_init ! va aussi reconstruire les tables d'offset ' Gosub Nice4 ! fait en nice4 If Wopen!(4) @Wsetsl(4) Endif If Not Nice! ! bin oui on peut Gosub Rdw_all(4) Endif ' Endif Return ' ' ' ' ' Gestionnaire de sauvegarde multiples Function Env_save @Save.vdt(0) Return True Endfunc Procedure Opt_save(N&) Local A& ' Exdo!=True Ob_state(Adr%(14),Opt_1&)=Bclr(Ob_state(Adr%(14),Opt_1&),0) Ob_state(Adr%(14),Opt_2&)=Bclr(Ob_state(Adr%(14),Opt_2&),0) Ob_state(Adr%(14),Opt_3&)=Bclr(Ob_state(Adr%(14),Opt_3&),0) Ob_state(Adr%(14),Opt_4&)=Bclr(Ob_state(Adr%(14),Opt_4&),0) Ob_state(Adr%(14),Opt_5&)=Bclr(Ob_state(Adr%(14),Opt_5&),0) Ob_state(Adr%(14),Opt_6&)=Bclr(Ob_state(Adr%(14),Opt_6&),0) Ob_state(Adr%(14),Opt_7&)=Bclr(Ob_state(Adr%(14),Opt_7&),0) Ob_state(Adr%(14),Opt_8&)=Bclr(Ob_state(Adr%(14),Opt_8&),0) If Btst(N&,0) Ob_state(Adr%(14),Opt_1&)=Bset(Ob_state(Adr%(14),Opt_1&),0) Endif If Btst(N&,1) Ob_state(Adr%(14),Opt_2&)=Bset(Ob_state(Adr%(14),Opt_2&),0) Endif If Btst(N&,2) Ob_state(Adr%(14),Opt_3&)=Bset(Ob_state(Adr%(14),Opt_3&),0) Endif If Btst(N&,3) Ob_state(Adr%(14),Opt_4&)=Bset(Ob_state(Adr%(14),Opt_4&),0) Endif If Btst(N&,4) Ob_state(Adr%(14),Opt_5&)=Bset(Ob_state(Adr%(14),Opt_5&),0) Endif If Btst(N&,5) Ob_state(Adr%(14),Opt_6&)=Bset(Ob_state(Adr%(14),Opt_6&),0) Endif If Btst(N&,6) Ob_state(Adr%(14),Opt_7&)=Bset(Ob_state(Adr%(14),Opt_7&),0) Endif If Btst(N&,7) Ob_state(Adr%(14),Opt_8&)=Bset(Ob_state(Adr%(14),Opt_8&),0) Endif ' A&=Byte(@Form_wdo(14,0)) Ob_state(Adr%(14),A&)=Bclr(Ob_state(Adr%(14),A&),0) ~@Form_wdo(14,-3) Gosub W_rdexe ' Gosub Defmouse(2) If A&=Opt_ok& If Not Btst(Ob_state(Adr%(14),Opt_3&),0) If Btst(Ob_state(Adr%(14),Opt_4&),0) If @Form_alert(1,"[2][Sauver police&dimensions sans|les styles est impossible, |sauver styles?][ Oui | Non ]")=1 Ob_state(Adr%(14),Opt_3&)=Bset(Ob_state(Adr%(14),Opt_3&),0) Endif Endif Endif ' If Btst(Ob_state(Adr%(14),Opt_1&),0) Gosub Sv.cnf Endif If Btst(Ob_state(Adr%(14),Opt_2&),0) Gosub Save_rep Endif If Btst(Ob_state(Adr%(14),Opt_3&),0) If Btst(Ob_state(Adr%(14),Opt_4&),0) Gosub Save_col(0) Else Gosub Save_col(1) Endif Endif If Btst(Ob_state(Adr%(14),Opt_5&),0) Gosub Save_mdm Endif If Btst(Ob_state(Adr%(14),Opt_6&),0) Sv_pho Endif If Btst(Ob_state(Adr%(14),Opt_7&),0) Gosub Save_exe Endif If Btst(Ob_state(Adr%(14),Opt_8&),0) @Save_transf Endif Endif Gosub Defmouse(0) ' Return ' Procedure Set_mdm Local A& ' For A&=0 To 5 Char{{Ob_spec(Adr%(13),Md_1&+A&)}}=Modem$(A&) Next A& ' Exdo!=True A&=Byte(@Form_wdo(13,0)) Ob_state(Adr%(13),A&)=Bclr(Ob_state(Adr%(13),A&),0) ~@Form_wdo(13,-3) If A&=Md_ok& For A&=0 To 5 Let Modem$(A&)=Char{{Ob_spec(Adr%(13),Md_1&+A&)}} If Len(Modem$(A&))=0 Let Modem$(A&)="\*" Endif Next A& Endif Exdo!=True ' Return ' ' Procedure Save.vdt(F&) Local A% Local File$ ' If @Tstblk If Binp%>0 ' Gosub Infreg ' If Len(Register$)>0 ' go menu.info("Sauver buffer") If Left$(File$(2),1)<>"*" If F&=0 If Len(Vpath$)>0 File$(2)=Vpath$ Endif File$=@Fsel$("\*.VDT",File$(2),"Sauver buffer vdt") Else File$=@Fsel$("\*.TXT",File$(2),"Sauver texte ascii") Endif Gosub Defmouse(2) Else File$=File$(2) Endif ' If Len(File$)>0 ' If Left$(File$,1)<>"*" If @Exist(File$) If @Form_alert(2,"[2]["+"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$ ' ' Protection Ncach&=((Ncach&*(-@Check1+1))/2) ' ~@Wind_update01(1) If F&=0 Fmshow("Sauvegarde du buffer vid‚otex") Else Fmshow("Sauvegarde du texte ascii") Endif ' Erreur!=False ' open "O",#1,File$(2) Fileh&=@Fcreate(File$(2),0) If @Tsterr(Fileh&) If Erreur!=False ' * If Acc!=False ' print #1,binair$; ' ~@Tsterr(@Fwrite(Fileh&,binair$)) ~@Tsterr(@Fadrwrite(Fileh&,Binair%,Binp%)) ' *Else ' For A%=1 To Len(binair$) ' * For A%=0 To Binp%-1 ' *@Tran(Chr$(Byte{Binair%+A%})) ' print #1,Tr_t$; ' *Exit if @Fwrite(Fileh&,Tr_t$)<0 ' Exit if Erreur!=True ' *Next A% ' *Endif Endif ' Edited!(actb&+3)=False ! sauv‚! ' close #1 ~@Tsterr(@Fclose(Fileh&)) Endif ~@Wind_update01(0) Fmhide Gosub Comm.info("Sauver *.VDT","Buffer VDT sauv‚") Endif ' Else Gosub Comm.info("Sauver *.VDT","annul‚") Endif Erreur!=False Gosub Defmouse(0) ~@Wind_update01(0) Endif ' Else Menu.info("Buffer vide, sauvegarde impossible!") Endif Endif ' Return ' Procedure Load.vdt(F&) Local File$ Local Adr% Local A! ' If Magneto&=-1 If @Form_alert(1,"[3][Enregistrement en cours!][Continuer|Abandon]")=1 Clr Magneto& Endif Else if Magneto&=1 @Beep Endif ' If Magneto&=0 ' go menu.info("Charger buffer") A!=False If F&=-1 If Len(Vpath$)>0 File$(2)=Vpath$ If Not Vkeep! Clr Vpath$ Endif Endif File$=@Fsel$("\*.VDT",File$(2),"Charger buffer vdt") A!=True Else if F&=0 File$=@Fsel$("\*.*",File$(2),"Charger un fichier ") A!=True Else if F&=-2 If Len(Tpath$)>0 File$(0)=Tpath$ If Not Tkeep! Clr Tpath$ Endif Endif File$=@Fsel$("\*.*",File$(0),"Charger texte") A!=True Else if F&=1 File$=File$(2) File$(2)=Ncol And + And Err$( Endif ~@Wind_update01(1) Gosub Defmouse(2) ' If A! If Len(File$)>0 $S% Select Right$(File$,4) Case ".BLK" File$(4)=File$ Gosub Clp_img(2) ! image! Clr File$ Case ".IMG",".GIF",".TGA",".JPG",".PNT",".BMP",".IFF",".PCX",".PCD",".TIF",".TNY",".ART",".FTC",".PIC",".NEO",".DOO",".PNT",".MAC",".PAC",".XGA",".ESM",".GEM",".SEF",".PI1",".PI2",".PI3",".PC1",".PC2",".PC3" ~@Form_alert(1,"[1][Image non g‚r‚e!|Passez sous: |Piccolo ou D2M, BV4..][Confirmer]") Clr File$ Case ".PRG",".TOS",".TTP",".APP",".GTP",".RSC",".CNF",".DAT" ~@Form_alert(1,"[1][Fichier non chargeable!][Annuler]") Clr File$ Endselect $S& Endif Endif ' If Len(File$)>0 If @Exist(File$) If F&=-2 File$(0)=File$ Else File$(2)=File$ Endif ' ' binair$="" Binp%=0 ' ~Fre(0) ' If Flag! Fmshow("Chargement du buffer vid‚otex") Else Fmshow("Chargement du fichier") Endif Erreur!=False ' open "I",#1,File$ Adr%=Fgetdta() ~Fsfirst(File$,0) ! pour dta ' Fileh&=@Fopen(File$,0) If @Tsterr(Fileh&) ' If Long{Adr%+26}Binlen% ~@Mfree(Binair%) Binlen%=Max(Min(Malloc(-1)-8192,Min(9999999,Long{Adr%+26})),Minbin&) Endif ' If @Tstblk If Long{Adr%+26}<=Binlen% ' binair$=Input$(Lof(#1),#1) ' binair$=@Fread$(Fileh&,Long{Adr%+26}) ~@Tsterr(@Fadrread(Fileh&,Binair%,Long{Adr%+26})) Binp%=Long{Adr%+26} Gosub Comm.info("Charger *.VDT","Charg‚: buffer,: "+Right$(File$,30)) ' Edited!(actb&+3)=False Else If @Form_alert(1,"[2][Fichier trop gros! |Charger le d‚but? ][Confirmer| Annuler ]")=1 ' binair$=Input$(32000,#1) ' binair$=@Fread$(Fileh&,32000) ~@Tsterr(@Fadrread(Fileh&,Binair%,Binlen%)) Binp%=Binlen% Gosub Comm.info("Charger *.VDT","Charg‚: buffer,: "+Right$(File$,30)) ' Gosub Comm.info("M","Buffer vdt, longueur: "+Str$(Len(binair$))+" octets.") Gosub Comm.info("M","Buffer vdt, longueur: "+Str$(Binp%)+" octets.") ' Edited!(actb&+3)=False Else Gosub Comm.info("Charger *.VDT","annul‚") Endif Endif ' ' Window If F&=-2 If Binp%>0 ~@Wind_open(3) Gosub Clp_lire(10) Endif Endif Endif Endif ' close #1 ~@Tsterr(@Fclose(Fileh&)) ~@Wind_update01(0) Fmhide ' Else ~@Form_alert(1,Errn33$) Gosub Comm.info("Charger *.VDT","Fichier introuvable") Endif If Wopen!(1) Rd_all(1,W_ix&(1),W_iy&(1),W_iw&(1),W_ih&(1)) Endif ' Else Gosub Comm.info("Charger *.VDT","annul‚") Endif Erreur!=False Gosub Defmouse(0) ~@Wind_update01(0) Endif ' Return ' ' Recevoir Procedure Recept Local Index& Local A& ' If @Tstblk If Magneto&<=0 If Capt|>0 Char{Ob_spec(Adr%(15),Cp_inf&)}="Status capture:" Gosub Sel_pop(Adr%(15),Cp_typ&,Capt|) Gosub Sel_pop(Adr%(15),Cp_enr&,Tcap|+1) Ob_state(Adr%(15),Cp_txt&)=Bclr(Ob_state(Adr%(15),Cp_txt&),3) Ob_state(Adr%(15),Cp_n&)=Bclr(Ob_state(Adr%(15),Cp_n&),3) ' Char{Ob_spec(Adr%(15),Cp_n&)}=Str$(Len(binair$)) Char{Ob_spec(Adr%(15),Cp_n&)}=Str$(Binp%) Ob_flags(Adr%(5),Cp_ok&)=Bclr(Ob_flags(Adr%(5),Cp_ok&),2) Ob_state(Adr%(15),Cp_ann&)=Bset(Ob_state(Adr%(15),Cp_ann&),3) Ob_state(Adr%(15),Cp_stop&)=Bclr(Ob_state(Adr%(15),Cp_stop&),3) Char{Ob_spec(Adr%(15),Cp_ok&)}="Continue" Else ' @Videmntl Char{Ob_spec(Adr%(15),Cp_inf&)}="Capturer pages:" Gosub Sel_pop(Adr%(15),Cp_typ&,1) Ob_state(Adr%(15),Cp_txt&)=Bset(Ob_state(Adr%(15),Cp_txt&),3) Ob_state(Adr%(15),Cp_n&)=Bset(Ob_state(Adr%(15),Cp_n&),3) Char{Ob_spec(Adr%(15),Cp_n&)}="----" Ob_flags(Adr%(5),Cp_ok&)=Bset(Ob_flags(Adr%(5),Cp_ok&),2) Ob_state(Adr%(15),Cp_ann&)=Bclr(Ob_state(Adr%(15),Cp_ann&),3) Ob_state(Adr%(15),Cp_stop&)=Bset(Ob_state(Adr%(15),Cp_stop&),3) Char{Ob_spec(Adr%(15),Cp_ok&)}="D‚marrer" Endif ' Exdo!=True A&=Byte(@Form_wdo(15,0)) ~@Form_wdo(15,-3) Ob_state(Adr%(15),A&)=Bclr(Ob_state(Adr%(15),A&),0) Tcap|=@State_pop(Adr%(15),Cp_enr&)-1 ' If Capt|<>0 If A&=Cp_stop& Gosub Magn(6) Else Capt|=@State_pop(Adr%(15),Cp_typ&) Endif ' Else ' If A&=Cp_ok& If Binp%>0 If Form_alert(1,"[2][Effacer le buffer actuel?][ Oui |Non]")=1 ' Clr binair$ Clearbin Endif Endif Capt|=@State_pop(Adr%(15),Cp_typ&) Edited!(Captb&+3)=True Endif Endif ' If Capt|=0 Mgstate(0) Else Mgstate(-1) ! REC! Endif ' Else ~@Form_alert(1,"[3][Visualisation en cours!][Continuer]") Endif ' ' Gosub Comm.info("M","Buffer VDT capture: "+Str$(Captb&+1)+", longueur: "+Str$(Len(binair$))+" octets.") Endif ' Return ' ' ' =Init Procedure M_init Local A& Local P$ Local A$ ' Rim_init ' If Not Accessoire! ! sinon splouf!!! If W_desk&<=500 ! ‚cran trop petit! If @Form_alert(1,"[3][R‚solution trop petite|pour "+Name$+"][Annuler|Continuer]")=1 On error gosub Eop Edit Endif Endif Endif ' ' Animation Set_mouse&=0 ' ' If Vopen!=False ' open "O",#5,"AUX:" ! flux sortie RS232 ' 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.. ' Menu_adr%=-1 ! pas de menu pour le moment ' ' File$: File sans () Dim File$(8) ! noms de fichier ' 2: *.VDT File$(2)="VIDEOTEX.VDT" File$(1)="EXEMPLE.MAC" File$(0)="SWIFTELP.TXT" File$(3)="TEXTE.TXT" File$(4)="IMAGE.BLK" ' ' ' 'Gosub Errstr ! chaines erreur ' ' Gosub Eval_init ! Inits pour ' Gosub Vxinit ! l'‚valuateur! ' ' Dim Dovar#(15) ! Local pour Do ' ' If False ! ////// ' ' Gosub Rsrc_load ! ressourcefile ' Endif ' ' ' ' ' print "Sizes and planes" ' Get_csize Gosub Getplane ! init plans ' CaractŠres initiaux If Ncach&=0 Ncach&=65536/(@Bitlen(Ccsizex&,Ccsizey&)+4) Endif Ncach&=Max(16,Ncach&) Ncach&=Min(4096,Ncach&) ' ' ' print "Swiftel! emul" ! WHY?? ' ''' Gosub Emul_init ' print "Swiftel! drcs man" ' ''' Gosub Drcs_init ' Gosub Bit_init ' Dim Msg&(7) ' ' Rim_init ' ' Dim Par_p&(9) ! Params ' Nmac&=99 Dim Mac$(Nmac&+2),Maci$(Nmac&+2),Mastr$(10),Macf$(Nmac&+2) ' ' Bufio%=@Malloc(2048) ! buffer i/o ' ' Return ' =Uninit Procedure M_uninit ' Rim_uninit Gosub Closelog Gosub Rsrc_free Gosub Emul_uninit ' Erase binair$() If Not Set_escape! ! Ne pas quitter sans effacer les champs Erase File$() ! noms fichiers Erase Msg&() Erase Mac$(),Maci$(),Mastr$(),Macf$() Erase Rac$(),Racb&(),Racc&() Endif If Clp%>0 ~@Mfree(Clp%) ~@Mfree(Clpref%) Clplen%=0 Endif If Iclp%>0 ~@Mfree(Iclp%) ~@Mfree(Imf%) Endif ' ' ~@Mfree(Bufio%) ' @Direct(Set_path$) Return Procedure Initel ' Gosub Inivars ' 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 ! alors modifier! ' Endif ' @Videmntl ' ' D‚sinterlacage/Interlacage (index<->couleur) ' Dim Intercol&(7),Extercol&(7),Vtcol&(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 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$ Local A&,B& ' ' UnInit If Dim?(Em$()) Gosub Emul_uninit Endif ' 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 ' Dim Tempo&(100*3) ! tempo blk ' F_c&=38 Pc_a&=0 ' Dim Spe|(5) ! 6 chars pile max Special&=0 Dim Spedr|(13) ! 14 sextets DRCS Dim Vids&(99,50) Dim Vidc&(99,50) Dim Vida|(99,50) Dim Vidterm|(50) ! taille ligne en mode terminal! ' Dim Csip&(31),Csix!(31) ! Params CSI ' Dim Vidrd|(99,50) ! redraw array Dim Vidrdc&(100*52),Vidrdx&(100*52),Vidrdy&(100*52) ! array redraw Vidrdexe!=False ! redraw all (cls) flag Vidrdall!=False ! redraw all (cls) flag Viddec!=False ! pas de d‚coupage de page pour l'instant Vidrdl&=0 ! nb lignes … d‚caler (au format standard, alg‚brique) ' Dim Vmap!(1,255) ! Videotex Map E$="{|}~`_/\^ß®¯" For A&=1 To Len(E$) Vmap!(0,Asc(Mid$(E$,A&,1)))=True Next A& E$="|_/\" For A&=1 To Len(E$) Vmap!(1,Asc(Mid$(E$,A&,1)))=True Next A& ' ' Tableaux pour effacer! Dim Vclrs&(99) Dim Vclrc&(99,7) ! oui, 8 couleurs! Dim Vclra|(99) Dim Vclrrd|(99) Arrayfill Vclrs&(),32 Arrayfill Vclra|(),&X1000000 ! Inhibiteur pour fond XXXX Arrayfill Vclrrd|(),&HFF ! Modifi‚! ' For A&=0 To 7 For B&=0 To 99 Vclrc&(B&,A&)=A& Next B& Next A& ' ' ''' Dim VIDI|(99,25) ! fictif SUPPRIME Dim Vsavet&(50) ! 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 Tcol&(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|)=Min(Work_out(13),E|) ' Tcol&(E|,1)=Min(Work_out(13),E|) ' Tcof!(E|)=False ! non flash Next E| ' ' Cf bloc suivant ' A$="SWCOL"+Hex$(Work_out(13),3)+".CNF" ' 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 ' ' If Len(Col$)=0 ' A$="SWCOL"+Hex$(Work_out(13),3)+".CNF" If (Not Gris!) A$="SWP3_COL.P"+@Nstr$(Plans&) Else A$="GRIS.P"+@Nstr$(Plans&) Endif Colgen$=@Finput$(A$) If Len(Colgen$)=0 A$="SWVDI"+Hex$(Work_out(13),3)+".CNF" Colgen$=@Finput$(A$) Else ' PARX_PALVVPP.. If Left$(Colgen$,8)="PARX_PAL" And Cvi(Mid$(Colgen$,11,2))<=Plans& Colgen$=Mid$(Colgen$,13) ! couper header Else Clr Colgen$ Endif Endif If Len(Colgen$)>0 Col$=Colgen$ Endif Endif ' If Len(Xcol$)>0 Termf|=Asc(Mid$(Xcol$,1,1)) Termt|=Asc(Mid$(Xcol$,2,1)) Endif If Len(Swcol$)>0 ' Gosub Defmouse(2) ' open "I",#1,A$ Select Len(Swcol$) ! 8*6*2 Case 96,100,104 To A&=1 For E|=0 To 7 Fcol&(E|)=Cvi(Mid$(Swcol$,A&,2)) Add A&,2 Fstyl|(E|)=Cvi(Mid$(Swcol$,A&,2)) Add A&,2 Findex|(E|)=Cvi(Mid$(Swcol$,A&,2)) Add A&,2 ' Tcol&(E|,0)=Cvi(Mid$(Swcol$,A&,2)) Tcol&(E|)=Cvi(Mid$(Swcol$,A&,2)) Add A&,2 ' If E|=0 Finv|=Min(1,Cvi(Mid$(Swcol$,A&,2))) Endif ' Tcol&(E|,1)=Cvi(Mid$(Swcol$,A&,2)) Add A&,2 ' Tcof!(E|)=(Cvi(Mid$(Swcol$,A&,2))<>0) Add A&,2 Next E| Endselect If Len(Swcol$)=>104 Efont&=Cvi(Mid$(Swcol$,A&,2)) Add A&,2 Vdt_tail&=Cvi(Mid$(Swcol$,A&,2)) Add A&,2 Eccsizex&=Cvi(Mid$(Swcol$,A&,2)) Add A&,2 Eccsizey&=Cvi(Mid$(Swcol$,A&,2)) Add A&,2 ' If Len(Swcol$)>104 Set_drfnt!=(Asc(Mid$(Swcol$,A&,1))<>0) Add A&,1 Drfnt_name$=Mid$(Swcol$,A&+2,Cvi(Mid$(Swcol$,A&,2))) Add A&,Cvi(Mid$(Swcol$,A&,2))+2 Endif ' If Eccsizex&=0 Or Eccsizey&=0 Eccsizex&=8 ! arbitraires Eccsizey&=16 Else ' On note, pour faire un Nice() aprŠs.. l'init ne servant qu'… initialiser euhh.. Eccldx&=Eccsizex& Eccldy&=Eccsizey& ' Endif ' Endif ' close #1 ' Gosub Defmouse(0) Endif ' ' ' Fait en ld.cnf ' 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 Textx&*Texty&=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) Texty&=Ptsout(3) ' Contrl(0)=117 ! Inquire Character Cell Width Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Vdisys ' ' Eccsizex&=Ptsout(0) Textx&=Ptsout(0) ' Else ' Eccsizex&=Ccsizey& Textx&=Ccsizey& ' Eccsizey&=Ccsizey& Texty&=Ccsizey& Efont&=1 Endif If Efont&<=0 Efont&=1 Endif Endif ' If Eccsizex&*Eccsizey&=0 Eccsizex&=Textx& Eccsizey&=Texty& Endif ' ' W&=Eccsizex& W&=Textx& ' H&=Eccsizey& H&=Texty& ' If Dim?(Wopen!()) ' Wset_max_w(4,Eccsizex&*85) ! ‚mulateur Wset_max_w(4,Textx&*85) ! ‚mulateur ' Wset_max_h(4,Eccsizey&*30) ! Wset_max_h(4,Texty&*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) Texty&=Ptsout(3) ' Contrl(0)=117 ! Inquire Character Cell Width Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Vdisys ' Eccsizex&=Ptsout(0) Textx&=Ptsout(0) ' Etext&(4)=Ccsizey& ! taille txt, 4=sweet OUI OUI ' Etext&(4)=Texty& ! taille txt, 4=sweet ' ' Arrayfill Decalt&(),Ptsout(1) ! d‚calage NON PAS LE MEME! For A&=0 To 3 Emul_text(A&) Contrl(0)=38 Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys ' Decalt&(A&)=Ptsout(1) ! d‚calage pour la taille A& Decalt&(A&)=Eccsizey&*(1-Btst(A&,0))-(Ptsout(3)-Ptsout(1)) ! d‚calage pour la taille A& Next A& Emul_text(0) ' ' Eccsizex&=20 ' Eccsizey&=20 ' Set_text&=0 If Dim?(Wopen!()) Gosub Field_max Endif Emul!=True ! mode ‚mul ' ' Taille offset car. graphique Vd_e1&=Eccsizex&\2 Vd_e2&=Eccsizey&\3 ' If Prg_id&=>0 ! command‚ Emul!=True Recept!=False Endif ' Gosub Photo_init Gosub Drfnt_init ' Return Procedure Photo_init ' Maxp&=101 ! nbr max de photos … l'‚cran ' X(0..39),Y(1..24),adresse photo,premier long (dimensions) de Po() pour v‚rif Dim Px&(Maxp&),Py&(Maxp&),Pa%(Maxp&),Pza%(Maxp&),Po%(Maxp&),Pzo%(Maxp&) Np&=1 ! pointeur sur emplacement photo libre ' Dim Vidp|(99,50) Arrayfill Vidp|(),0 ' ' Gestion minitel photo (buffer JPEG) If Photom%>0 ~@Mfree(Photom%) Endif Photoptr%=0 Photolen%=Min(Max(Malloc(-1)-2048,$ And And And And Eqv Mod ),Ph_siz%) Photom%=@Malloc(Photolen%+32) If Photom%<=0 ~@Form_error(1,"[1][Plus assez de m‚moire!|(buffer photo)][Annuler]") Set_end!=True Endif ' ' -------COPIE DE RTD-------- ' Default: P_araw%=4 P_arah%=3 P_loch#=0 P_locv#=0 P_sizw#=1 P_sizh#=0.75 P_offh#=0 P_offv#=0.75 ' 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 Drfnt_init Local A$ ' If Set_drfnt! If Len(Drfnt_name$)>0 Clr Drfnt_auto$ A$=Set_path$+"SYSTEME\FONTES\"+Drfnt_name$ Drfnt_auto$=@Finput$(A$) If Left$(Drfnt_auto$,8)="SWT2DRCS" Rafale!=False Else Clr Drfnt_auto$ Endif Endif Endif Return ' $P< Procedure Sweety_text @Deftextattrb(0) If Set_text&<>-1 And Set_system&<>2 ! 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)=Or_tail& ! pas font_tail Vdisys ' Get_csize Endif Return Procedure Sw_clip Local Rx&,Ry&,Rw&,Rh& ' Rx&=X_desk& Ry&=Y_desk& Rw&=W_desk& Rh&=H_desk& If Rc_intersect(W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4),Rx&,Ry&,Rw&,Rh&) If Rc_intersect(@Wxacoord(4,Emx&),@Wyacoord(4,Emy&),(Vmax_x&+1)*Eccsizex&,(Vmax_y&+1)*Eccsizey&,Rx&,Ry&,Rw&,Rh&) Clip(Rx&,Ry&,Rw&,Rh&) Else Wind_clip(4) Endif Else Wind_clip(4) Endif Return $P> ' Clip local! (Reclipper ensuite) Procedure Swpart_clip(X&,Y&,W&,H&) If Rc_intersect(Clip_x&,Clip_y&,Clip_w&,Clip_h&,X&,Y&,W&,H&) Clip X&,Y&,W&,H& Endif Return ' Procedure Emul_uninit Gosub Set_col(False) Gosub Sweety_text If Not Set_escape! ! Ne pas quitter sans effacer les champs Erase Em$() Erase Vids&(),Vidc&(),Vida|(),Vidterm|() Erase Vidrd|(),Vidrdc&(),Vidrdx&(),Vidrdy&() Erase Vclrs&(),Vclrc&(),Vclra|(),Vclrrd|() Erase Vsavet&() Erase Tempo&() Erase Csip&(),Csix!() Clr Emulm|,X_curs&,Y_curs& Erase Spe|(),Spedr|() Endif Cache_uninit If Not Set_escape! ! Ne pas quitter sans effacer les champs Erase Fcol&(),Fstyl|(),Findex|() Erase Tcol&() Erase Etext&(),Decalt&() ! table des tailles, d‚calage low line Erase Vd_drm&() Erase Vmap!() Endif ' Gosub Photo_uninit Return Procedure Photo_uninit Local A& Local Adr% ' If Np&>1 For A&=1 To Np&-1 Adr%=Pa%(A&) ~@Mfree(Adr%) Pa%(A&)=Adr% ' Adr%=Po%(A&) ~@Mfree(Adr%) Po%(A&)=Adr% Next A& Endif ' If Photom%>0 ~@Mfree(Photom%) Endif If Not Set_escape! ! Ne pas quitter sans effacer les champs Erase Vidp|(),Px&(),Py&(),Pa%(),Po%(),Pza%(),Pzo%() Endif Np&=1 Return ' Cls Procedure Photo_clear Local A& Local Adr% ' If Np&>1 For A&=1 To Np&-1 Adr%=Po%(A&) ~@Mfree(Adr%) Po%(A&)=Adr% ' Adr%=Pa%(A&) ~@Mfree(Adr%) Pa%(A&)=Adr% Next A& Np&=1 Endif Return ' Procedure Cache_init Local A&,T# ' If Dim?(Cachs&()) Cache_uninit Endif ' ' 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&)+4),Ncach&) Ncach&=Max(2,Ncach&) ' ' Dim cache$(Ncach&+1) ! Cache vid‚o ' Cachex&=Eccsizex& Cachey&=Eccsizey& Cachexx%=@Bitlen(Cachex&,Cachey&) ! 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 ' NB: des 1/8 ou 1/10 ca tombe tjs juste!! 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 ' ' Tables mosa‹que Vd_e1&=Eccsizex&\2 Vd_e2&=Eccsizey&\3 ' ' Table PHOTO, <> de la pr‚c‚dente: table d'‚paiseurs des lignes pour Xgtrnsf() Dim Pt&(1,9) ! (0,0..7) et (1,0..9) Arrayfill Pt&(),-1 ! Tout pr‚d‚fini … -1 (=1.. c…d rap) ' ' NB: des 1/8 ou 1/10 ca tombe tjs juste!! If Eccsizex&<>8 Or Eccsizey&<>10 ' Une ‚paisseur peut valoir 0 (sauter trame) ou 1 (trame intacte) T#=(Eccsizex&)/8 ! pas en X For A&=0 To 7 Pt&(0,A&)=Round((A&+1)*T#)-Round(A&*T#) Next A& T#=(Eccsizey&)/10 ! pas en Y For A&=0 To 9 Pt&(1,A&)=Round((A&+1)*T#)-Round(A&*T#) Next A& Endif ' Gosub Clear_cache ' Gosub Pho_calc ' Return Procedure Cache_uninit ' Erase cache$(),Cachs&(),Cachc&(),Cacha|() If Not Set_escape! ! Ne pas quitter sans effacer les champs Erase Cachs&(),Cachc&(),Cacha|() Erase Drbit|() Erase Pt&() Endif ~@Mfree(Caches%) Clr Rovcach& ' Return Procedure Clear_cache Local A& Local A% ' 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&) ! place A%=(Ncach&+1)*Cachexx% Caches%=@Malloc(A%) ' If Caches%<0 ' print "cx ";Cachex&, ' print "cy ";Cachey&, ' print "cl ";Cachexx%, ' Print ' print "eccsizexy",Eccsizex&,Eccsizey& ' Print ' print "ncach ";Ncach&,"caches ";Caches%, ' Print ' print "fre0 ";Fre(0), ~@Form_error(1,"[1][Plus de m‚moire disponible|en ‚mulation!|("+Str$(A%)+"o)][Annuler]") Endif ' Clr Rovcach& Return ' Procedure Save_col(A&) Local E| ' ~@Wind_update01(1) Fmshow("Sauvegarde des styles") Gosub Defmouse(2) ' open "O",#1,Set_path$+"SWCOL"+Hex$(Work_out(13),3)+".CNF" Fileh&=@Fcreate(Set_path$+"SYSTEME\"+"SWCOL"+Hex$(Work_out(13),3)+".CNF",0) If @Tsterr(Fileh&) ~@Tsterr(@Fwrite(Fileh&,"XCOL"+Chr$(Termf|)+Chr$(Termt|)+String$(26," "))) ' ~@Tsterr(@Fwrite(Fileh&,Mki$(Fcol&(0))+Mki$(Fstyl|(0))+Mki$(Findex|(0))+Mki$(Tcol&(0))+Mki$(Finv|)+Mki$(0))) For E|=0+1 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|)); ' ~@Tsterr(@Fwrite(Fileh&,Mki$(Fcol&(E|))+Mki$(Fstyl|(E|))+Mki$(Findex|(E|))+Mki$(Tcol&(E|,0))+Mki$(Tcol&(E|,1))+Mki$(Tcof!(E|)))) ~@Tsterr(@Fwrite(Fileh&,Mki$(Fcol&(E|))+Mki$(Fstyl|(E|))+Mki$(Findex|(E|))+Mki$(Tcol&(E|))+Mki$(0)+Mki$(0))) Next E| Gosub Defmouse(0) @Showm If A&=-1 ~@Wind_update01(0) A&=@Form_alert(1,"[2][Sauver paramŠtres texte? |(type fonte+taille page)][ Oui | Non ]")-1 ~@Wind_update01(1) Endif If A&=0 Gosub Defmouse(2) ' print #1,Mki$(Efont&); ' print #1,Mki$(Vdt_tail&); ~@Tsterr(@Fwrite(Fileh&,Mki$(Efont&)+Mki$(Vdt_tail&))) ~@Tsterr(@Fwrite(Fileh&,Mki$(Eccsizex&)+Mki$(Eccsizey&))) ' ~@Tsterr(@Fwrite(Fileh&,Chr$(Set_drfnt!)+Mki$(Len(Drfnt_name$))+Drfnt_name$)) Endif Gosub Defmouse(2) ' close #1 ~@Tsterr(@Fclose(Fileh&)) Endif Gosub Defmouse(0) Fmhide ~@Wind_update01(0) Return Procedure Set_col(Flag!) Local A& ' If Len(Col$)>0 If Flag! If Mcol! 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 Min(Len(Col$)\6-1,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+$ And And And And Imp !È!f1 <Ž\fèè1ff4f$Space$( And And And And And Eqv Or ,2)) Vdisys Next A& Else ' 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 !È!f1 <Ž\fèè1ff4f$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 ! 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+1+2,2)) Intin(3)=Cvi(Mid$(Colbak$,A&*6+1+4,2)) Vdisys Next A& Endif Clr Colbak$ Endif Else If Len(Colbak$)=0 If Mcol! 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 Endif Return Procedure Recol Local A$ ' Gosub Set_col(False) If (Not Gris!) A$="SWP3_COL.P"+@Nstr$(Plans&) Else A$="GRIS.P"+@Nstr$(Plans&) Endif Colgen$=@Finput$(A$) If Len(Colgen$)=0 A$="SWVDI"+Hex$(Work_out(13),3)+".CNF" Colgen$=@Finput$(A$) Else ' PARX_PALVVPP.. If Left$(Colgen$,8)="PARX_PAL" And Cvi(Mid$(Colgen$,11,2))<=Plans& Colgen$=Mid$(Colgen$,13) ! couper header Else Clr Colgen$ Endif Endif If Len(Colgen$)>0 Col$=Colgen$ Endif Set_col(True) Return ' $P< Procedure Clr_spe Arrayfill Spe|(),&HFF ! AŠ char suivant char sp‚cial Arrayfill Spedr|(),&HFF ! Pile DRCS Return $P> Procedure Emulm(E|) Local A!,B! ' A!=(Emulm|<>E|) ! Change mode B!=((E|=0)<>(Emulm|=0)) ! Change size ' ' Plus de rouleau & drcs Rmode!=False Dmodet!=False Dmodeg!=False ' Cache_uninit 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‚ ~@Titlew(4,Name$+" ~ Vid‚otex") 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‚ ~@Titlew(4,Name$+" ~ Vid‚otex 80") Case 3 Vmax_x&=Xterm&-1 Vmax_y&=Yterm& ! Eh oui, 25 plus ligne 0! F_c&=Vmax_x& Ncurs!=True ! Curs activ‚ Clr Ccurs& ~@Titlew(4,Name$+" ~ VT-100") Endselect Cache_init ' If (Not Connect!) ! changement de conf If Speed&=4 @Setspeed Endif Endif ' ' Repassage en texte, mais est-ce du drcs?? ' If Dmodet! ' Acurs|=Bset(Acurs|,7) ! DRCS ' Else ' Acurs|=Bclr(Acurs|,7) ! TEXT ' Endif ' Wset_max_w(4,Eccsizex&*(Vmax_x&+2)+Emx&) Wset_max_h(4,Eccsizey&*(Vmax_y&+2+8)+Emy&+Emy2&) ' If B! ! Change size If Nice! If Emulm|>0 Eccx&=Eccsizex& Eccy&=Eccsizey& If (Vmax_x&+1)*Eccsizex&>W_desk&-W_ex&(4) Or (Vmax_y&+1)*Eccsizey&>H_desk&-W_ey&(4) Gosub Nice_size(Min((Vmax_x&+1)*Eccsizex&+Emx&+4,W_desk&-W_ex&(4)),Min((Vmax_y&+1)*Eccsizey&+Emy&+Emy2&+4,H_desk&-W_ey&(4))) Endif Else If Eccx&>0 And Eccy&>0 Gosub Nice_size(Min((Vmax_x&+1)*Eccx&+Emx&+4,W_desk&-W_ex&(4)),Min((Vmax_y&+1)*Eccy&+Emy&+Emy2&+4,H_desk&-W_ey&(4))) Endif Endif Endif Else ' If A! If Nice! Gosub Nice4 Endif Endif Endif ' If Not A! If Wopen!(4) Wsetsl(4) Endif Endif ' For X&=0 To Vmax_x& Vidc&(X&,0)=&H700 Vids&(X&,0)=32 Vida|(X&,0)=&X1000000 ! Inhibiteur pour fond XXXX Next X& Photo!=False Gosub Vcls(False) ' If (Not Nice!) Rdw_all(4) Else If Not B! Gosub Vcls_draw Endif Endif Gosub Test_menu ' Return ' Function Crc83(E$) Local A& Local S& Clr S& For A&=1 To Len(E$) S&=Byte(A&+Len(E$)+S&+Asc(Mid$(E$,A&,1))) Next A& Return S& Endfunc ' ' ' A appeller periodiquement Flag: afficher ? (sous routine) Procedure Tmanage(Flag!) Local A!,B! Local C& Local T& Local Em_x%,A% Local A& ' Local I_& ' ~@Wind_update01(0) Clr B! ! d‚codage acc‚l. If Magneto&<=0 Or Magneto&=>10 If Binair%<=0 Capt|=0 Endif ' Sw_clip ! clipping fenˆtre Gosub Connect ! v‚rifier DSR/DCD I_&=@Bios1 If I_& ~@Wind_update01(11) ' ' * If Bufio%>0 ! octets d‚tect‚s A!=@Tstwork(4) ! ‚mul fonctionnel? Recu!=True ! s‚maphore de test ' If Not Recept! ! de tt fa‡ons ne rien recevoir! A!=False Endif ' If Imp(Not A!,Capt|<>0) ! si pas d'‚mul, capture?! ' ' R‚ception en "rafale" If A! If Flag! If Rafale! B!=True Flag!=False ' Vidrdexe!=False ! redraw all (cls) flag ' Vidrdall!=False ! redraw all (cls) flag ' Clr Vidrdl& ' Arrayfill Vidrd|(),False ! fait! ' Viddec!=False ! pas de d‚coupage de page pour l'instant Endif Endif Endif ' Lastsend|=25 ! on vient de recevoir (cf princ) ' Gosub Defmouse(2) If A! Sw_clip ! clipping fenˆtre @Deftextattrb(0) If Flag! @Hidem ! OUI AUSSI Endif @Drcurs(False) ! OUI Endif Swt&=1 ' ~@Infow(4,"R‚ception en cours.. [SHIFT]-[SHIFT] {+[CTRL]} pour interrompre") ~@Infow(4,"") Clr T& While @Bios1 ' * Repeat ' 'Em_c&=@Xinp1 ' Em_c&=@Bios2 ' *Len%=Gemdos(63,Devh&,L:2048,L:Bufio%) ! lecture de max. 2Kos ' *If Len%>0 ' *For A%=0 To Len%-1 ' *Em_c&=Byte{Bufio%+A%} ' ' ' -------------------- ' If Emulm|<>3 ! pas en mode terminal! ' If Connect! And (Not Set_send!) ' If (Not Set_send!) If (Not Em_tlcposx!) $S& Select Em_c& Case Em_tlc0& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=0 Case Em_tlc1& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=1 Case Em_tlc2& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=2 Case Em_tlc3& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=3 Case Em_tlc4& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=4 Case Em_tlc5& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=5 Case Em_tlc6& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=6 Case Em_tlc7& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=7 Endselect ' Else if Em_tlcpos&=2 ' print "starts" Em_tlcposx!=False Select Em_tlcposid& Case 0 If Em_tlc0p&=Em_c& Em_tlcposx!=True Inc Em_tlcpos& Endif Case 1 If Em_tlc1p&=Em_c& Em_tlcposx!=True Inc Em_tlcpos& Endif Case 2 If Em_tlc2p&=Em_c& Em_tlcposx!=True Inc Em_tlcpos& Endif Case 3 If Em_tlc3p&=Em_c& Em_tlcposx!=True Inc Em_tlcpos& Endif Case 4 If Em_tlc4p&=Em_c& Em_tlcposx!=True Inc Em_tlcpos& Endif Case 5 If Em_tlc5p&=Em_c& Em_tlcposx!=True Inc Em_tlcpos& Endif Case 6 If Em_tlc6p&=Em_c& Em_tlcposx!=True Inc Em_tlcpos& Endif Case 7 If Em_tlc7p&=Em_c& Em_tlcposx!=True Inc Em_tlcpos& Endif Endselect If Not Em_tlcposx! Em_tlcpos&=-2 ! v‚rifier non red‚marrage Endif Else If Asc(Mid$(Tlc$(Em_tlcposid&),Em_tlcpos&,1))<>Em_c& For A&=0 To 7 If Left$(Tlc$(Em_tlcposid&),Em_tlcpos&-1)=Left$(Tlc$(A&),Em_tlcpos&-1) ! idem un autre If Asc(Mid$(Tlc$(A&),Em_tlcpos&,1))=Em_c& Em_tlcposid&=A& ! nouvel id!! exemple: *B00 et *B01 ' print "Swapped at ";A& Endif Endif Next A& Endif ' ' print "Tlcpos: ";Em_tlcpos& If Asc(Mid$(Tlc$(Em_tlcposid&),Em_tlcpos&,1))=Em_c& Inc Em_tlcpos& If Em_tlcpos&>Len(Tlc$(Em_tlcposid&)) ! ID!! ' $S% Select Upper$(Right$(Tlcid$(Em_tlcposid&),4)) Case ".SPM" If @Exist(Set_path$+"SYSTEME\MACROS\"+Tlcid$(Em_tlcposid&)) ' @Vprint("") ~@Macload(Set_path$+"SYSTEME\MACROS\"+Tlcid$(Em_tlcposid&)) Gosub Macexe ' @Vprint("") Else Eminfo("#Macro non trouv‚e, "+Tlcid$(Em_tlcposid&)) Endif Case ".PRG",".APP",".TOS",".TTP",".GTP" If @Exist(Set_path$+"SYSTEME\MACROS\"+Tlcid$(Em_tlcposid&)) ' @Vprint("") Prgl(Tlcid$(Em_tlcposid&),"") ' @Vprint("") Else Eminfo("#Programme non trouv‚, "+Tlcid$(Em_tlcposid&)) Endif ' Default ! prg en acc par exemple (shel_write) Gcontrl(0)=13 ! Appl_find Gcontrl(1)=0 ! G-intin Gcontrl(2)=0 Gcontrl(3)=1 ! G-adrin Addrin(0)=V:Tlcid$(Em_tlcposid&) ! Addrin #1 Gemsys 13 ! AES Em_x%=Gintout(0) ! Id ' If Em_x%=>0 Gosub Defmouse(0) ' @Vprint("") Eminfo("#T‚l‚chargement fichier: "+Tlcid$(Em_tlcposid&)+".ACC") @Beep Gosub Xxappl(Em_x%,&H28,Em_x%,Em_x%,0,0,0) ! open! ~Evnt_timer(500) ' @Videmntl Else Eminfo("#Protocole non trouv‚, "+Tlcid$(Em_tlcposid&)+".ACC non pr‚sent") Endif Endselect $S& ' Em_tlcposx!=False Clr Em_tlcpos&,Em_tlcposid& Endif Else Clr Em_tlcpos&,Em_tlcposid&,Em_tlcposx! Em_tlcpos&=-2 ! red‚marrage? Endif Endif ' ' Red‚marrage.. ex: **B00 ou ***B0 If Em_tlcpos&=-2 Em_tlcpos&=0 $S& Select Em_c& Case Em_tlc0& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=0 Case Em_tlc1& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=1 Case Em_tlc2& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=2 Case Em_tlc3& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=3 Case Em_tlc4& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=4 Case Em_tlc5& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=5 Case Em_tlc6& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=6 Case Em_tlc7& Em_tlcposx!=True Em_tlcpos&=2 Em_tlcposid&=7 Endselect ' Endif ' Endif ' Endif ' -------------------- ' ' If Mexe! If Wexep&>0 If Asc(Mid$(Wexe$,Wexep&,1))=Em_c& Inc Wexep& If Wexep&>Len(Wexe$) Clr Wexep& Endif Else Wexep&=1 If Asc(Mid$(Wexe$,Wexep&,1))=Em_c& Inc Wexep& Endif Endif Endif Endif ' If Capt|<>0 ! 1= capturer 2= fin page If Magneto&=-1 ! pas de PAUSE If Em_c&=12 And Capt|=2 Magn(6) Else ' binair$(Captb&)=binair$(Captb&)+Chr$(em_c) ' binair$=binair$+Chr$(em_c) Byte{Binair%+Binp%}=Em_c& ! Yo! Inc Binp% If Binp%=>Binlen% Mgstate(100) ! wait.. If @Updtblk(Binlen%+8192)=0 ! pas possible d'agrandir ~@Wind_update01(0) ~@Form_error(1,"[1][Capture:|Buffer plein ET m‚moire pleine|Max: "+Str$(Binlen%\1024)+"K][ Fin ]") Magn(6) ~@Wind_update01(11) Endif If Capt|<>0 Mgstate(-1) Endif Endif Endif Else if Magneto&=0 Capt|=0 Endif Endif ' If A! ' Em_c&=C& Em_fl!=Flag! ' Gosub Emanage(Flag!,C&) Gosub Emanage Endif Inc T& ' If Mod(T&,32)=0 Clr T& ' C&=@Shift C&=And(Bios(11,-1),&X1111) $S& Select C& Case &X11 ! shift shift If Flag! ~@Infow(4,"D‚codage acc‚l‚r‚") B!=True Flag!=False Vidrdexe!=False ! redraw all (cls) flag Vidrdall!=False ! redraw all (cls) flag Clr Vidrdl& Arrayfill Vidrd|(),False ! fait! Viddec!=False ! pas de d‚coupage de page pour l'instant Endif Case &X111 ! shift shift crtl If @Form_alert(2,"[2][Passer en arrˆt?|(interrompre r‚ception)][Confirmer| Anuler ]")=1 Emul!=True ! off mode Recept!=False ! (arrˆt) Exit if True Endif Endselect Endif $S% ' Wend ' *Next A% ' *Endif ' ' Until (Not Bios(1,Rsdev&)) ' *Until Len%<=0 Wend ' Clr Swt& ' ~@Infow(4,"R‚ception effectu‚e") ~@Infow(4,"") Gosub Magc ! infos recorder ' Gosub Drawx(4) If A! ' @Lhidem ' @drcurs(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 Endif ' If B! Gosub Vrefresh Endif ' Return ' ' * * Routine g‚n‚rale de gestion de caractŠre * * ' G‚rer char C ; Flag: afficher ? $P< Procedure Emanage ' Procedure Emanage(Flag!,C&) ' Local A&,X&,X%,Y&,D% ' N&,B& ?? ' Locaux remplac‚s! ' ' ' D‚sactiver curseur si ce n'est pas d‚ja fait! If Vcr! @Drcurs(False) Endif ' ' Octet nul filtr‚, sauf en r‚ception fichier ETSI!! If Em_c&<>0 Or (Photo!) ' If (Not Connect!) If (Not Set_send!) ! non connect‚ If Not Set_speed! ! modem If Not Hsm! ! pas hsmodem $S& Select Em_ctc& ! dernier char Case "C" If Em_c&=Asc("O") Em_ctc&=Em_c& Else Clr Em_ctc& Endif Case "O" If Em_c&=Asc("N") Em_ctc&=Em_c& Else Clr Em_ctc& Endif Case "N" If Em_c&=Asc("N") Em_ctc&=Asc("n") Else Clr Em_ctc& Endif Case "n" If Em_c&=Asc("E") Em_ctc&=Em_c& Else Clr Em_ctc& Endif Case "E" If Em_c&=Asc("C") Em_ctc&=Asc("c") Else Clr Em_ctc& Endif Case "c" If Em_c&=Asc("T") Em_ctc&=Em_c& Else Clr Em_ctc& Endif Case "T" $S& Select Em_c& Case 13,32 ! CONNECT ou CONNECT ' ' Ne doit jamais arriver si HSMODEM est install‚.. @Eminfo("Connexion") If (Not Set_send!) Connect!=True Gosub Xconnect Gosub Test_menu If Em_fl! Vdraw(F_c&,0) Else Vidrd|(F_c&,0)=&HFF ! redraw quand mˆme ? Endif Endif ' Endselect Clr Em_ctc& ' Default If Em_c&=Asc("C") Em_ctc&=Em_c& Else Clr Em_ctc& Endif Endselect Endif Endif Endif Endif ' ' 'Em_d!=False ! redraw all? ' M%=False ?? ' Reset sequence: If Special&<>0 If Em_c&<32 ! car. sp‚ciaux If Special&<>&HFF And (Not Photo!) Select Rol(Spe|(0),16)+Rol(Spe|(1),8) Case &H3A6600 ! transparence Default If Special&<>&HFE Or Em_c&=27 Clr Special&,Em_a& Endif Endselect Endif Endif Endif If Special&=0 ' ' * * * * * * * * * * * * * If (Not Vtransp!) Or Em_c&=27 $S& Select Em_c& ' ' ---------------------------------------- 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) ' Gosub Ecatest00 ! 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&,Em_c&,Em_fl!) ' 'Echar00 ' If Cnext|<>&HFF ! annuler If Btst(Acurs|,4) ! graphique Cnext|=&HFF ! annuler Endif Endif ' Else ! 80col If Em_c&<>127 ! 127 interdit Echar(X_curs&,Y_curs&,Em_c&,Em_fl!) ' Echar00 Endif Endif ' ' If Y_curs&=0 ! Surveiller affichage ligne 0 ' If Connect! ' If Pal1cnx&<=0 And Pal0cnx&=>0 ! Pas encore de pallier 1 ' @Chk_tar ' ' Endif ' Endif ' Endif ' ' ' ---------------------------------------- Case 32 ! espace If Emulm|=0 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) Gosub Ecatest00 ! 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&,Em_c&,Em_fl!) ! traiter char! ' Echar00 ! 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&,Em_c&,Em_fl!) ! 80col, rap! ' Echar00 ! 80col, rap! Endif ' ' -------------------------------------------------------------------------------- Case 27,31,18,19,22,25 ! Esc,Pos,Rep,Sep If Emulm|<>3 ! terminal, ignorer! If Not Photo! Special&=Em_c& Clr_spe If Em_c&=31 If Y_curs&<>0 ! sinon ne pas faire !!! Clr_a0 ! effacer registres de sauvegarde! Endif Endif Endif ' Else ! terminal If Em_c&=27 Special&=27 Clr_spe Endif Endif ' Case 5 ! ENQ, demande lecture ROM If @Answer @Emtechinfo("Identification ROM->") If Len(Id$)>0 ' @Outvid(Chr$(1)+Id$+Chr$(4)) Fsend(Chr$(1)+Id$+Chr$(4)) Endif Endif ' Case 7 ! Beep!! If Em_fl! @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 If Emulm|<>3 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,Em_fl!) ! {\ curs=1 ou scroller! If Emulm|=0 ! non ansi If Not Btst(Acurs|,4) ! si texte! Ccurs&=And(Ccurs&,&HFF00) Endif Endif ' 'Gosub Yc /\ ! {/ remplacent ycurs1 Endif Endif Vdt_setme Else X_curs&=((X_curs&+8)\8)*8 ! Tab X_curs&=Min(Vmax_x&,X_curs&) Endif Case 10 ! Bas,Lf If Y_curs&<>0 Inc Y_curs& If Y_curs&>Vmax_y& ' Ycurs1 Y_curs&=@Ynewcurs(1,Em_fl!) If Emulm|=0 ! non ansi If Not Btst(Acurs|,4) ! si texte! Ccurs&=And(Ccurs&,&HFF00) Endif 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&=@Ynewcurs2(1,Em_fl!) Endif Vdt_setme Endif Case 12 ! Cls If Emulm|=0 ' Si en ligne0, alors DRCS s'en va.. If Y_curs&=0 Dmodet!=False Dmodeg!=False Endif ' Gosub Vcls(Em_fl!) ' ' If em_fl! ' 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,Em_fl!) ' 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 ' Et hop! Cf BUG REPORT Vida|(X_curs&,Y_curs&)=Bset(Vida|(X_curs&,Y_curs&),5) 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 ' If Btst(Acurs|,4) ! (**) ' Acurs|=Bset(Acurs|,5) 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&) ' ' Oui mais attention! le starter doit ˆtre activ‚ IMMEDIATEMENT aprŠs ' Exemple: posNM GRAPH FOND_VERT ' ' TEXTE 'XXXX YYYY' posNM FOND_BLEU ' ' ' -> Les "XXXX YYYY" doivent tous deux ˆtre color‚s, il ne doit pas y avoir de ' starter aprŠs le XXXX (… cause du 'XXXX' et non ' XXXX') ' ' -> Starter "sauvage" MAIS SEULEMENT SI AVANT GRAPHIQUE ' ' ' Else Acurs|=Bclr(Acurs|,5) ! ANSI Endif ' Case 17 ! Curs on If Emulm|=0 @Vcurs(False) Ncurs!=True ' @Vcurs(True) ! NAAAN!!! 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(Em_fl!) Else ' Pav‚ plein en 80 col! Em_c&=127 Echar(X_curs&,Y_curs&,Em_c&,Em_fl!) Endif ' Case 26 ! Pav‚Plein ' Pav‚ plein en 80 col! (mˆme en 40) Em_c&=127 Echar(X_curs&,Y_curs&,Em_c&,Em_fl!) ' 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 0 ! on ne fait rien! ' Endselect Endif ! si pas transparent! ' ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Else ! char sp‚ciaux : Special|<>0 ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' If Em_c&=27 And Em_a&<>&HFF And (Not Photo!) Special&=Em_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 if Photo! ! PHOTO ' Special&=&H70 Em_a&=&H70 ' 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 Em_c&=31 And Not Photo! ! 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&=Em_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 Em_a&=-1 ! on continue!! ' ' Else if Em_a&=&H70 ! PHOTO ' ' ' ' ' ' ' Clip Off ' Text 10,10,Str$(Phorec%)+" " ' Reclip ' Else if Em_a&=&H70 ! PHOTO $S& Select Em_c& ! FF D9 ? (fin) Case &HD9 If Byte{Photom%+Photoptr%-1}=&HFF ! FIN Sub Phoblk%,Phorec%-1 ' print "FINAL=";Phoblk% ' ' @Emtechinfo("Avis de fin de transfert d'image JPeG") ' Clr Special& ' Photo!=False ' Phorec%=1 ! et voilu! ' Dec Photoptr% ! un de moins (FF) Endif ' ' ' Codes vid‚otex? (reset etc..) ' NON! Le minitel n'en a rien … faire! Case &H7F ! 1B 39 7F RESET VIDEOTEX - INTERROMPRE ETSI If Byte{Photom%+Photoptr%-1}=&H39 If Byte{Photom%+Photoptr%-2}=&H1B If Cnxf! ! appui sur Cnx/Fin ' Cnxf!=False ' ' Copie de RESET ' ---------------------------------------- @Emtechinfo("Reset vid‚otex ->") Gosub Rep_reset ' Gosub Rep_ini40 ' ' If Emulm|<>0 ' Gosub Emulm(0) ' Endif @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 Dmodet!=False Dmodeg!=False Vmode!=False Vtransp!=False ! plus de transparence Photo!=False Vdt_setme Endif ' ---------------------------------------- ' Endif Endif ' Endselect ' ' Photod$=Photod$+Chr$(Em_c&) If Em_a&<>-2 Em_a&=-1 Endif ' If (Not Photo!) ! Arrˆt If Em_a&<>-2 Clr Special& Endif ' Else ' Byte{Photom%+Photoptr%}=Em_c& Inc Photoptr% If Photoptr%=>Photolen% ! impossible mais bon.. Clr Special& Photo!=False Eminfo("Erreur d‚codage photo: plus de m‚moire!") ~@Form_error(1,"[1][Erreur d‚codage photo:|plus de m‚moire!][Annuler]") Endif Endif ' ' Dans le bloc il y a tout ce qui est envoy‚ aprŠs un ESC+p: CMI,PM,LI,PDE ' D‚codage de tout le bloc suivant ESCp ' If Photo! ! non interrompu et non fini $S% Select Photoptr%-Photosp% ! taille re‡ue (nouveau bloc) Case 1 Phorec%=-1 Pholi$="%" ! Photo LI identifier (ouarf') If Byte{Photom%+Photosp%}<>&H23 Eminfo("Erreur d‚codage photo: bad photographic mode ("+Hex$(Byte{Photom%+Photosp%})+")") Endif Case 2 Case 3 If Byte{Photom%+Photosp%+2}<>&H7F ' If Byte{Photom%+Photoptr%}<>&H40 ! -> pas compatible avec le profile P1 Eminfo("Erreur d‚codage photo: bad picture ID ("+Hex$(Byte{Photom%+Photosp%+2})+")") Endif Default ' If Phorec%<0 ' LI $S& Select And(Em_c&,&X1100000) Case &X1000000 ! last one Pholi$=Pholi$+Bin$(And(Em_c&,&X11111),5) ' Clr Phojmp! Phorec%=Val(Pholi$) If Photosp%<=0 ! pas de blocs avant Phoblk%=Phorec% ! taille bloc total Phostart%=Photoptr% ! start PDE (JPEG ou commande) Clr Phostart2% Else Phojmp!=True ! sauter le 1er octet du PDE! Add Phoblk%,Phorec% ! en plus! Phostart2%=Phostart% ! ancien start! (au cas ou on aurai un bloc <>52) Phostart%=Photoptr% ! start PDE (JPEG ou commande) ' Photoptr%=Photosp% ! ‚crire … la suite! (‚craser header qui ne sert plus … rien!) Endif Clr Pholi$ ' print "RECEPT ";Phorec%;" / ";Phoblk% ' ' Infos r‚ception: Em_a%=Phostart2% If Em_a%=0 Em_a%=Phostart% Endif Select Byte{Photom%+Em_a%} Case &H50,&H51 @Eminfo("R‚ception en-tˆte: "+Str$(Phorec%)+"/"+Str$(Phoblk%)+" octets") Case &H52,&H53 @Eminfo("R‚ception image: "+Str$(Phorec%)+"/"+Str$(Phoblk%)+" octets") Default @Eminfo("R‚ception fichier: "+Str$(Phorec%)+"/"+Str$(Phoblk%)+" octets") Endselect Clr Em_view& ! pour animation.. ' Case &X1100000 ! Keme Pholi$=Pholi$+Bin$(And(Em_c&,&X11111),5) Default Eminfo("Erreur d‚codage photo: bad LI") Clr Photo!,Special& Endselect Else ! r‚ception If Phojmp! ! fusion? Phojmp!=False Select Em_c& Case &H52 ! bloc interm‚diaire! Phostart%=Phostart2% ! restaurer pour fusion Photoptr%=Photosp% ! recaler pour sauter l'octet en trop Case &H53 Phostart%=Phostart2% ! restaurer pour fusion Photoptr%=Photosp% ! recaler pour sauter l'octet en trop Byte{Photom%+Phostart%}=&H53 Default ! pas le bon bloc! Eminfo("Erreur d‚codage photo: bad block") Endselect Photosp%=0 ! ok effacer (fusion sur le d‚but) Endif ' Dec Phorec% If Phorec%=0 ! exit Photo!=False Clr Special& Else ' Animation [***.......] If Phoblk%<>0 ! ne devrait pas arriver.. If Em_view&<>(Phorec%*10)/Phoblk% Em_view&=(Phorec%*10)/Phoblk% ' ' Infos r‚ception: Em_a%=Phostart2% If Em_a%=0 Em_a%=Phostart% Endif Select Byte{Photom%+Em_a%} Case &H50,&H51 @Eminfo("R‚ception en-tˆte: ["+String$(10-Em_view&,"*")+String$(Em_view&,".")+"] ("+Str$(Phoblk%)+"o)") Case &H52,&H53 @Eminfo("R‚ception image: ["+String$(10-Em_view&,"*")+String$(Em_view&,".")+"] ("+Str$(Phoblk%)+"o)") Default @Eminfo("R‚ception fichier: ["+String$(10-Em_view&,"*")+String$(Em_view&,".")+"] ("+Str$(Phoblk%)+"o)") Endselect Endif Endif Endif ' Endif ' Endselect $S& Endif ' ' Fin photo, fin donn‚es, et pas interr. If (Not Photo!) And (Phorec%=0) And (Em_a&<>-2) Phorec%=0 Clr Em_a$ ! message d'erreur ‚ventuel ' ' D‚codage: ' If Byte{Photom%}=&H23 ! (ESCp) # If Byte{Photom%+1}=&H40 ! (ESCp) # @ If Byte{Photom%+2}=&H7F ! (ESCp) # @ <7F> $S& Select Byte{Photom%+Phostart%} Case &H50,&H51 ! en tˆte -> ‚tat 3 ' ' Byte{Photom%+Photoptr%}=0 ! end ' print ">";Char{Photom%+Phostart%+1};"<" Em_p&=1 ! var locale, pos Em_instr&=0 ! id instruction Do ' D‚codage des instructions PHOTO: ' ' ID Instruction Em_instr&=Shl(Byte{Photom%+Phostart%+Em_p&},8)+Byte{Photom%+Phostart%+Em_p&+1} ' Add Em_p&,2 ! sauter ID instruction ' ' Len pour 1 param (peut ˆtre corrig‚ aprŠs!) Em_l&=2+Byte{Photom%+Phostart%+Em_p&+1} ! head+len ' Em_v%=0 Em_v#=0 ' Type <..> $S& Select Byte{Photom%+Phostart%+Em_p&} ! type Case &H40 ! INT ' If Em_l&=2+2 Em_v%=@Valint(Photom%+Phostart%+Em_p&) ' Endif Case &H41 ! REAL Case &H42 ! NORM ' If Em_l&=2+2 Em_v#=@Valnorm(Photom%+Phostart%+Em_p&) ' Endif Case &H43 ! DEC Case &H44 ! ENUM (si octet alors noter!) If Em_l&=2+1 Em_v%=Byte{Photom%+Phostart%+Em_p&+2} Else if Em_l&=2+2 Em_v%=Shl(Byte{Photom%+Phostart%+Em_p&+2},8)+Byte{Photom%+Phostart%+Em_p&+3} Endif Case &H45 ! BOO ' If Em_l&=2+2 Em_v%=@Valint(Photom%+Phostart%+Em_p&) Em_v%=(Em_v%<>0) ' Endif Case &H46 ! STR Endselect ' ' Sauter instr+head+param1 -> on pointe sur prochain ou param2 Add Em_p&,Em_l& Clr Em_l& ! ne pas sauter (d‚ja fait) ' ' Puis traiter: ' RTD TY 01 P1 ' <..> ' Instruction, quasiment toutes sont ignor‚es (elles sont saut‚es directement) ' rien=pas trait‚ *=traiter ‚vent. -=ne doit pas ˆtre trait‚ ' d=fictif, paramŠtres ne servent … rien! $S& Select Em_instr& Case &H2030 ! RTD * If Em_v% Clr P_mod& Clr P_araw%,P_arah% Clr P_locv#,P_loch#,P_sizw#,P_sizh# Clr P_refh%,P_refv% Clr P_offh#,P_offv# ' ' Default: Clr P_mod& ! mode 0 P_araw%=4 P_arah%=3 P_loch#=0 P_locv#=0 P_sizw#=1 P_sizh#=0.75 P_offh#=0 P_offv#=0.75 ' ' Endif Case &H2130 ! FSD ' =0 Case &H2131 ! ASR d ' len pour 2 params ' [<..>] <..> P_araw%=Em_v% Em_v%=@Valint(Photom%+Phostart%+Em_p&) P_arah%=Em_v% Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} Case &H2132 ! LOC * P_loch#=Em_v# Em_v#=@Valnorm(Photom%+Phostart%+Em_p&) P_locv#=Em_v# Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} Case &H2133 ! PAS * P_sizw#=Em_v# Em_v#=@Valnorm(Photom%+Phostart%+Em_p&) P_sizh#=Em_v# Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} ' ' BUG! Les STUM confondent h (horizontal) et h (height, vertical) ' Quels cons! C'est pas vraiment pareil.. Swap P_sizw#,P_sizh# ! et hop! ' Case &H2134 ! PPL * P_refh%=Em_v% ' Em_v%=@Valint(Photom%+Phostart%+Em_p&) P_refv%=Em_v% Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} ' Em_v#=@Valnorm(Photom%+Phostart%+Em_p&) P_offh#=Em_v# Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} ' Em_v#=@Valnorm(Photom%+Phostart%+Em_p&) P_offv#=Em_v# Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} ' Case &H2135 ! CPA * ' Effacer.. If Em_v% Gosub P_calc ! calculer coordonn‚es Pho_clr(P_ox&,P_oy&,P_w&,P_h&,Em_fl!) Endif ' Case &H2230 ! PCT - Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} Case &H2231 ! PDS -- Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} Case &H2232 ! PID ' Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} ' Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} ' Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} ' Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} Case &H2233 ! SWD Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} Case &H2234 ! DCI If Em_v%=0 Endif Case &H2330 ! SCD ' Non g‚r‚ pour l'instant! Case &H2331 ! CDP - ' ' Le reste n'est pas compatible avec le profile P1 Case &H2332 ! CMO - Case &H2333 ! LAS - Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} Case &H2430 ! JPG - Case &H2431 ! ETM - Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} Add Em_p&,2+Byte{Photom%+Phostart%+Em_p&+1} Case &H2432 ! AMA - Case &H2433 ! T4C - Case &H2434 ! T6C - Case &H2530 ! TME * P_mod&=Em_v% ! mode de transcription ' Default ' print "Erreur d‚codage photo: unknown command ("+Hex$(Em_instr&) Eminfo("Erreur d‚codage photo: unknown command ("+Hex$(Em_instr&)+")") Endselect ' print "OK "+Hex$(Em_instr&,4);" " ' RTD TY 01 P1 ' <..=len> Add Em_p&,Em_l& ! ajout ‚ventuel ' print Phostart%+Em_p&,Photoptr% Loop until Phostart%+Em_p&=>Photoptr% ' Clr Photo!,Special& ' Clr Photosp% ! non!, commande.. ? Case &H52 Clr Photo!,Special& ! poursuivre aprŠs Photosp%=Photoptr% ! on peut recevoir 2 blocs cons‚cutifs ' Case &H53 ! photo JPEG ' Byte{Photom%+Photoptr%}=0 ! end ' print ">";Char{Photom%+Phostart%+1};"<" ' ' Coh‚rence des paramŠtres: ' print "P_loch/locv/offh/offv/sizh/sizw= " ' print P_loch#,P_locv#,P_offh#,P_offv#,P_sizh#,P_sizw#,, ' ' Note: on a invers‚ AVANT lors de la r‚ception de sizw,sizh , ces deux ' params. La doc STUMR&P est bugg‚e!! If P_refv%=0 And P_refh%=0 If P_loch#=>0 And P_locv#=>0 And P_loch#+P_offh#=>0 And P_locv#+P_offv#=>0 And P_loch#+P_sizh#=>0 And P_locv#+P_sizw#=>0 ' If P_loch#<=1 And P_locv#<=0.75 And P_loch#+P_offh#<=1 And P_locv#+P_offv#<=0.75 ' If P_loch#+P_sizh#<=1 And P_locv#+P_sizw#<=0.75 If True If True ' Gosub P_calc ! calculer coordonn‚es ' ' print "Px/y/w/h/ox/oy ";P_x&,P_y&,P_w&,P_h&,P_ox&,P_oy& ' ~Inp(2) ' If P_ox&=>0 And P_oy&=>1 And P_ox&+P_w&<=40 And P_oy&+P_h&<=25 If P_ox&=>0 And P_oy&=>1 And P_ox&<=40 And P_oy&<=25 ' ' D‚coder photo (ou dupliquer pour adresse paire!) P_a%=Photom%+Phostart%+1 P_l%=Photoptr%-Phostart%-1 @Pho_dec(P_a%,P_l%) ' If P_a%=>0 ! ok? If Btst(Ph_opt|,1) ! afficher photo ' Pho_put(Photom%+Phostart%+1,Photoptr%-Phostart%-1,P_ox&,P_oy&,Em_fl!) Pho_put(P_a%,P_l%,P_ox&,P_oy&,P_w&,P_h&,Em_fl!) Else Pho_clr(P_ox&,P_oy&,P_w&,P_h&,Em_fl!) Endif ' If Btst(Ph_opt|,0) ! sauver Dbgx$=@Fsel$("\*.JPG","PHOTO","Sauver JPeG?") If Len(Dbgx$)>0 If Photoptr%>0 Fmshow("Sauvegarde JPeG") Fileh&=@Fcreate(Dbgx$,0) If @Tsterr(Fileh&) ' ~@Tsterr(@Fadrwrite(Fileh&,Photom%+Phostart%+1,Photoptr%-Phostart%-1)) ~@Tsterr(@Fadrwrite(Fileh&,P_a%,P_l%)) ~@Tsterr(@Fclose(Fileh&)) Endif Fmhide Endif Endif Endif ' ' Lib‚rer bloc: ~@Mfree(P_a%) Clr P_a%,P_l% ' Endif ' Clr Photo!,Special&,Photoptr%,Photosp% Else Phorec%=1 Em_a$="Photographie non affichable, paramŠtres erron‚s (pos>max)" Endif ' Else Phorec%=1 Em_a$="Photographie non affichable, paramŠtres erron‚s (val2>max)" Endif Else Phorec%=1 Em_a$="Photographie non affichable, paramŠtres erron‚s (val1>max)" Endif Else Phorec%=1 Em_a$="Photographie non affichable, paramŠtres erron‚s (val. <0)" Endif Else Phorec%=1 Em_a$="Photographie non affichable, paramŠtres erron‚s (refv/h)" Endif ' Default Phorec%=1 Clr Photosp% Em_a$="PDE1 non compatible ETSI profil P1 (<"+Hex$(Byte{Photom%+2},2)+">)" Endselect Else Phorec%=1 ! erreur, … signaler Clr Photosp% Em_a$="En-tˆte non compatible ETSI profil P1 (

<#><@><"+Hex$(Byte{Photom%+2},2)+">)" Endif Else Phorec%=1 ! erreur, … signaler Clr Photosp% Em_a$="En-tˆte non compatible ETSI profil P1 (

<#><"+Hex$(Byte{Photom%+1},2)+">)" Endif Else Phorec%=1 ! erreur, … signaler Clr Photosp% Em_a$="En-tˆte non compatible ETSI profil P1 (

<"+Hex$(Byte{Photom%},2)+">)" Endif ' If Phorec%=1 ! erreur … traiter ou signaler (bloc inconnu) ' Em_a$="Le "+Date$+" … "+Time$+" sous "+Name$+Cr$+"Le bloc n'a pas pu ˆtre trait‚, ou n'a pas ‚t‚ reconnu"+Cr$+Cr$+"Raison:"+Cr$+Em_a$+Cr$+Cr$ ' print Em_a$ ' ~Inp(2) Pe_write(Photom%+Phostart%,Photoptr%-Phostart%,Em_a$) Clr Photo!,Special&,Photoptr%,Photosp% Endif ' ' Phorec%=-1 Clr Photoptr% Endif ' ' ' ' ---- Else if Em_a&=&HFE ! DRCS t‚l ' ---- ' ' If Spe|(2)=&HFF ! On ne t‚l‚charge pas de char! Select Em_c& Case &H1F ! Avis d'envoi de char If Y_curs&<>0 ! si en L0 aucun interˆt (et peut bugger en plus!) Keep_a0(True) ! sauver la pile si ca doit ˆtre un POS! Endif ' ' 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 Emtechinfo("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 Em_c&=&H1F If Y_curs&<>0 ! si en L0 aucun interˆt (et peut bugger en plus!) Keep_a0(True) ! sauver la pile si ca doit ˆtre un POS! Endif ' Spe|(2)=&HFF ! EOT‚l Else if Em_c&=&H30 ! Next char! Spe|(2)=&HFF ! EoT‚l, next char Else ' print "transmission nø"+Str$(Spe|(2)+1) Spedr|(Spe|(2))=Em_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)) ' ' Puis r‚actualiser! ' If Em_fl! ! rdw If Emulm|=0 ! euhhhh...... bin oui... If Afdrc! ! gestion aff drcs (sinon rap) Gosub Vdt_reac(Spe|(0),Spe|(1),Em_fl!) Endif Endif ' Endif ' ' Endif ' If Em_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 ' Emtechinfo("* 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 Em_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 est 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 Em_c&=&H23 ! Suivant 3/4 *ou* 1F 23 20 20 etc.. Spe|(2)=101 Else ! Sortie, traiter comme un POS! (ligne 0 par exemple ou FIN) ' Gosub Clr_spe ! on a sauv‚ le contexte avec keep_a0 avant si c'est un pos xx,0 Special&=31 ! Noter commande Spe|(0)=Em_c& ! Et 1er argument Em_a&=-2 ! run param! (cf … la fin) ' ' ' Else if em_c=&H41 ! D‚but de demande de fin de t‚l ' Spe|(2)=201 ' ' Eminfo("Erreur de protocole DRCS nø1/"+Str$(em_c)) ' print "error transmitt2:"+Str$(em_c) Endif Case 101 ' print "Demande de transmission 3/4" Em_c&=Em_c&-33 If Em_c&=>0 And Em_c&<=93 ! Ok? Spe|(2)=102 Spe|(1)=Em_c& ! ID du char! Else if Em_c&=-1 ! une s‚quence d'en tˆte maintenant!! (si!!) Clr_spe Special&=31 ! Noter commande Spe|(0)=&H23 ! Et 1er argument Spe|(1)=&H20 ! Et 2e argument Em_a&=-2 ! run param! (cf … la fin) ' Else ' Gƒƒƒƒrgl! Emtechinfo("Erreur de protocole DRCS, trop grand/"+Str$(Em_c&)) ' print "error char trop >:"+Str$(em_c) Endif Case 102 ' print "Demande de transmission 4/4" If Em_c&=&H30 Spe|(2)=&H0 ! GO! Arrayfill Spedr|(),0 ! Bufgf vide pour l'instant Else ' GnŒŒ.. Emtechinfo("Erreur de protocole DRCS nø2/"+Str$(Em_c&)) ' print "error transmitt:"+Str$(em_c) Endif ' ' Case 201 ' print "Demande de fin de transmission" ' If em_c=&H42 ! FIN DE TEL! ' Special&=0 ' Gosub Clr_spe ' Else ' ???? ' Eminfo("Erreur de protocole DRCS nø3/"+Str$(em_c)) ' print "error fin transmitt:"+Str$(em_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! ' ---- ' @Emtechinfo("Commande inconnue (interrompue) seg #1") Clr Special& ' ' Else ! s‚qence normale … traiter ' ' Spe|(Em_a&)=Em_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! ' Em_c&=-1 ! pas de char valide Select Spe|(0) Case "z" Em_c&=Asc("´") Case "j" Em_c&=Asc("µ") Case "'" Em_c&=Asc("Ý") Case "#" Em_c&=Asc("œ") Case "<" Em_c&=Asc("¬") Case "=" Em_c&=Asc("«") Case ">" Em_c&=Asc("þ") Case "." Em_c&=Asc("¯") Case "," Em_c&=Asc("®") Case "{" Em_c&=Asc("ž") Case "1" Em_c&=Asc("ñ") Case "8" Em_c&=Asc("ö") Case "0" Em_c&=Asc("ø") Case "/" Em_c&=Asc("ß") ! bah oui j'ai rien d'autre! ' Case "A","B","C","H","K" ! suivants Em_a&=-1 ' Default Em_c&=Asc("?") Endselect ' Endif ' ' Traiter comme un caracrŠre normal If Em_c&>0 If Not Vtransp! Echar(X_curs&,Y_curs&,Em_c&,Em_fl!) ' Echar00 Endif Endif ' ' Case 27 ! Esc? (1 paramŠtre) ' Select Spe|(0) Case "c" If Emulm|>0 ! sinon ne veut rien dire! Gosub Vcls(Em_fl!) Endif ' Case "[" ! CSI Clr Csi$ ! paramŠtres CSI Em_a&=-1 ! cont ' Case "p" ! r‚ception PHOTO (d‚but s‚quence) ETAT TERMINAL 1 If Emulm|=0 @Emtechinfo("Avis de passage mode ETSI") ' V‚rifier Photosp% Clr Photoptr% ! d‚but … priori If Photosp%<=0 ! pas de blk Clr Photosp% Else if Phostart%<=0 ! pas de donn‚es photo Clr Photosp% Else if Byte{Photom%+Phostart%}<>&H52 ! invalide pas 5/2 Clr Photosp% Else Photoptr%=Photosp% ! continuer (1er) Endif ' Photo!=True ! Mode PHOTO (plus de mode MINITEL) Special&=&H70 Em_a&=-1 Cnxf!=False ! avis d'appui sur cnx/fin: consid‚rer RESETs! Endif ' Case "@" To "G" ! Coul text If Not Vtransp! If Emulm|=0 Ccurs&=And(Ccurs&,&HFF) Ccurs&=Or(Ccurs&,(Spe|(Em_a&)-64)*&H100) ' ' Else ' ' Select Spe|(0) Case "D","E" ! idem LF et CR/LF ' -------Copie de Case 10--------- If Y_curs&<>0 Inc Y_curs& If Y_curs&>Vmax_y& ' Ycurs1 Y_curs&=@Ynewcurs(1,Em_fl!) If Not Btst(Acurs|,4) ! si texte! Ccurs&=And(Ccurs&,&HFF00) Endif ' Gosub Yc /\ ! {/ remplacent ycurs1 Endif Vdt_setme ' -------Copie de Case 10--------- ' If Spe|(0)=Asc("E") ' -------Copie de Case 13--------- X_curs&=0 Vdt_setme ' -------Copie de Case 13--------- Endif ' Else ! Ycurs=0 donc on restaure ancienne pos!! Gosub Restore_a0 ! restaurer Endif Endselect ' 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!! ' ' Oui BUG REPORT exemple: espaces+chr13+esc V+ctrl N+esp ' NAAAAAAAAAAAAAN g‚nŠre d'autre bugs!! ' Vida|(X_curs&,Y_curs&)=Bset(Vida|(X_curs&,Y_curs&),5) ' Fait APRES (cf graph) ' ' mais c'est aussi le cas si on fait un GRAPH ON, sur une ligne bleue par exemple! ' ' Endif ' Else ' ' Select Spe|(0) Case "M" ' ' -------Copie de Case 11--------- If Y_curs&<>0 ! ne fonctionne pas en l0 Dec Y_curs& If Y_curs&<=0 Y_curs&=@Ynewcurs2(1,Em_fl!) Endif Vdt_setme Endif ' -------Copie de Case 11--------- Endselect ' 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 ' ' C'est nous qui pouvons l'envoyer, sinon ENCRE XX ! ' Case &H61 ! position curseur ' If Not Vtransp! ' @Emtechinfo("Demande de position curseur") ' If @Answer ' print #5,@Pos$(X_curs&,Y_curs&); ! alors renvoyer!! ' Endif ' Endif ' Endif ' ' Case "%" ! Mode transparence (ou fin) If Emulm|=0 Em_a&=-1 Endif ' Case "/" ! Fin mode transparence If Emulm|=0 Em_a&=-1 Endif ' Case " " ! invitation … num‚roter IAN ou autre (DRCS) If Emulm|<>3 ! terminal, ignorer! Em_a&=-1 Endif ' ' ' WARNING!! ' Le modem PAD-X3 renvoi des codes sous la forme 1/B 2/X 3/Y 0/D !! ' On ne peut les diff‚rencier des autres codes de contr“le vid‚otex! ' Il faut donc ˆtre s–r, losqu'on recoit des commandes 1/B 2/, que ce sont ' bien des commandes transp, tarification.. etc.. et non pas des PAD-X3! Case "!" ! infos tarification If Emulm|<>3 ! terminal, ignorer! Em_a&=-1 Endif ' Case 34 ! " tarification en sortie teletel If Emulm|<>3 ! terminal, ignorer! Em_a&=-1 Endif ' Case "#" ! Masque/d‚masque If Emulm|=0 Em_a&=-1 Else if Emulm|=3 ! terminal Em_a&=-1 ! tailles ANSI Endif ' Case &H28,&H29 ! DRCS conf If Emulm|<>3 ! terminal, ignorer! Em_a&=-1 Endif ' Case &H20 To &H2F ! ‡a peut ˆtre une "indication d'‚chec de connexion" If Emulm|<>3 ! terminal, ignorer! Em_a&=-1 Endif ' Case &H39,&H3A,&H3B ! Pro-1,2,3 (1,2,3 params) If Emulm|<>3 ! terminal, ignorer! Em_a&=-1 ' Else ' Pas de PROx en Terminal!! Endif ' Case "5","6" ! s‚quences de fin de page - ignorer! If Emulm|<>3 ! terminal, ignorer! Em_a&=-1 Endif ' Case "7" If Emulm|<>3 ! terminal, ignorer! If Emulm|<>0 ! keep curs Keep_a0(0) ' Else Em_a&=-1 Endif Endif Case "8" If Emulm|<>3 ! terminal, ignorer! If Emulm|<>0 ! restore curs Restore_a0 Endif Endif ' Default Clr Special& ' a&=-1 Endselect ' Case 18 ! Rep If Emulm|=0 ! Mode vid‚otex If Spe|(0)-64>0 Em_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) Gosub Ecatest00 ! 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&,Em_c&,Em_fl!) ! traiter char! ' Echar00 ! 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&,Em_c&,Em_fl!) ' Echar00 Next Em_x% Endif Endif Endif ' Case 19 ! Sep If Not Vtransp! If Emulm|<>3 ! terminal, ignorer! Select Spe|(0) Case "^" ! 40 col If Emulm|<>0 Gosub Emulm(0) ' Em_d!=-1 ! redraw If Em_fl! Gosub Vcls_draw Endif Endif Case "S" ! avis de connexion/d‚cnx.. If (Not Set_send!) If (Not Hsm!) Connect!=Not Connect! Else Gosub Connect Endif Gosub Xconnect If Connect! @Eminfo("Connexion") Else @Eminfo("D‚connexion") Endif Gosub Test_menu If Em_fl! Vdraw(F_c&,0) Else Vidrd|(F_c&,0)=&HFF ! redraw quand mˆme ? Endif Endif Case "P" ! chg vitesse cnx @Emtechinfo("Changement vitesse modem … la connexion") Case "Q" ! ' ' en cours @Emtechinfo("Changement vitesse modem en cours de connexion") Case "V" ! ack mode @Emtechinfo("Ack changement de mode") Case "W" ! transp @Emtechinfo("Ack transparence") Case "X" ! deb/fin retournement @Emtechinfo("D‚but/fin retournement") Case "T" ! ? Case "\" ! copie ‚cran @Eminfo("Copie ‚cran sur imprimante") ' If @Answer ' Default ! Peut ˆtre une touche de fct ' print Chr$(Spe|(0)), Case "A" To "I" ! touche de fonction Gosub Sep_clav(Spe|(0)) Endselect Endif Endif ' Default ! Char avec ces param non d‚tect‚ Em_a&=-1 Endselect ' ' ------------------------------ Case 1 ! car sp‚cial + 2 params ' ------------------------------ ' If Special&=31 ' $S% Select Rol(Spe|(0),8)+Spe|(1) Case &H2320 ! D‚but de demande t‚l DRCS!! Em_a&=-1 ! continuer! ' Case &H2040 ! demande Gal d'identification @Emtechinfo("Demande g‚n‚rale d'indentification ->") Gosub Rep_gal ' Default ! pos! CHR 31 + YX @Vcurs(False) ' ' Pour tester annulation DRCS Em_x%=(Y_curs&=0) ' ' 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 ! on va en ligne 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 Else Spe|(0)=&HFF ! Mauvais POS, ignorer (ne pas effacer status!!) 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 Else Spe|(0)=&HFF ! Mauvais POS, ignorer (ne pas effacer status!!) Endif Else Spe|(0)=&HFF ! Mauvais POS, ignorer (ne pas effacer status!!) 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 If Em_x%<>(Y_curs&=0) Dmodet!=False Dmodeg!=False Endif ' 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! ' Em_c&=-1 ! pas de char valide Select Rol(Spe|(0),8)+Spe|(1) Case "Be" Em_c&=Asc("‚") Case "Aa" Em_c&=Asc("…") Case "Ae" Em_c&=Asc("Š") Case "Au" Em_c&=Asc("—") Case "Ha" Em_c&=Asc("„") Case "He" Em_c&=Asc("‰") Case "Hi" Em_c&=Asc("‹") Case "Ho" Em_c&=Asc("”") Case "Hu" Em_c&=Asc("š") Case "Ca" Em_c&=Asc("ƒ") Case "Ce" Em_c&=Asc("ˆ") Case "Ci" Em_c&=Asc("Œ") Case "Co" Em_c&=Asc("“") Case "Cu" Em_c&=Asc("–") Case "Kc" Em_c&=Asc("‡") Endselect ' ' Traiter comme un caracrŠre normal If Em_c&>0 Echar(X_curs&,Y_curs&,Em_c&,Em_fl!) ' Echar00 Endif ' Else if Special&=27 ' Select Rol(Spe|(0),8)+Spe|(1) ' 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 CSI ' Case &H5B CSI ' ' ' 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! If (Not Set_send!) @Eminfo("D‚connexion->") If (Not Hsm!) Connect!=False Gosub Xconnect Gosub Test_menu ' If Connect! ' @Eminfo("Connexion->") ' Else ' Endif If Em_fl! Vdraw(F_c&,0) Else Vidrd|(F_c&,0)=&HFF ! redraw quand mˆme ? Endif Endif Endif Endif Case &H3968 ! connexion If Not Vtransp! If (Not Set_send!) @Eminfo("Connexion->") If (Not Hsm!) Connect!=True Gosub Xconnect Gosub Test_menu If Em_fl! Vdraw(F_c&,0) Else Vidrd|(F_c&,0)=&HFF ! redraw quand mˆme ? Endif Endif Endif Endif Case &H396C ! retournement If Not Vtransp! @Emtechinfo("Retournement modem->") Endif Case &H396D ! ret inverse If Not Vtransp! @Emtechinfo("Retournement modem inverse->") Endif Case &H396E ! acq retournement If Not Vtransp! @Emtechinfo("Ack retournement modem->") Endif Case &H396F ! mode maitre If Not Vtransp! @Emtechinfo("Mode maitre-") Endif Case &H3970 ! status terminal If Not Vtransp! @Emtechinfo("Demande status terminal->") Gosub Rep_term Endif Case &H3972 ! status fonctionnement If Not Vtransp! @Emtechinfo("Demande status fonctionnement->") Gosub Rep_fonct Endif Case &H3974 ! status vitesse If Not Vtransp! @Emtechinfo("Demande status vitesse->") Gosub Rep_vit Endif Case &H3976 ! status protocole If Not Vtransp! @Emtechinfo("Demande status protocole->") Gosub Rep_protoc Endif Case &H3978 ! t‚l‚charger ram1 If Not Vtransp! @Emtechinfo("Demande t‚l‚chargement RAM #1 ->") Endif Case &H3979 ! ram2 If Not Vtransp! @Emtechinfo("Demande t‚l‚chargement RAM #2 ->") Endif Case &H397A ! id ram1 If Not Vtransp! @Emtechinfo("Demande identification RAM #1 ->") Endif Case &H397B ! id terminal If Not Vtransp! @Emtechinfo("Demande identification terminal ->") Gosub Rep_id Endif Case &H397C ! copie ‚cran If Not Vtransp! @Eminfo("Copie ‚cran") If @Form_alert(1,"[2][Imprimer page?][Confirmer| Annuler ]")=1 Gosub Emcut(0) Gosub Printbnr Endif Endif Case &H397F ! ReSet vid‚otex @Emtechinfo("Reset vid‚otex ->") Gosub Rep_reset ' If Emulm|<>0 ! OUI OUI Gosub Emulm(0) Endif @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 Dmodet!=False Dmodeg!=False Vmode!=False Vtransp!=False ! plus de transparence Photo!=False Vdt_setme ' ---------------------------------------- Case &H4763 ! fin mode transp Vtransp!=False ! arrˆt mode transparence ' Default ! PRO2,PRO3 Select Spe|(0) Case &H39 ! PRO1 1 seul param donc exit ' Case &H70 ! PHOTO Em_a&=-1 ! on continue, transparence ETSI.. ' Case "[" ! CSI Csi$=Csi$+Chr$(Spe|(1)) Spe|(Em_a&)=&HFF ! annuler, ne pas placer sur la pile If Len(Csi$)<255 ' If @T_csi(Em_fl!,Csi$) ! trait‚ Clr Csi$ Else Em_a&=-1 ! on continue sinon Endif ' Else @Emtechinfo("Commande Csi-"+Csi$+" non reconnue!") Clr Csi$ ! on abandonne Endif ' Case "%" ! transp If Spe|(1)=64 ! fin Vtransp!=False ! fin mode transparence Else Vtransp!=True ! mode transparence! Endif Case "/" If Spe|(1)=63 ! fin Vtransp!=False Endif ' Case "#" If Emulm|=0 Em_a&=-1 Else ! Cht de taille terminal ' Select Spe|(1) Case "5" ! normal (0) If Vidterm|(Y_curs&)<>0 Vidterm|(Y_curs&)=0 Endif Case "3" If Vidterm|(Y_curs&)<>3 Vidterm|(Y_curs&)=3 Endif Case "4" If Vidterm|(Y_curs&)<>4 Vidterm|(Y_curs&)=4 Endif Case "6" If Vidterm|(Y_curs&)<>6 Vidterm|(Y_curs&)=6 Endif Case "8" ! fill screen - non ex‚cut‚.. Endselect ' Endif ' Case &H20 To &H2F ! peut ˆtre "indication d'‚chec de connexion" Select Spe|(2) Case &H30 ! oui! If (Not Set_send!) @Eminfo("Echec … la connexion") @Tarif("!") ! echec cnx, pallier 0 Endif ' ' --- Default ' Case 34 \/ If Spe|(0)=34 If Spe|(1)=34 Em_a&=-1 Else ! euh ? Endif Else Em_a&=-1 Endif Endselect ' Case "5" ! +chr synchronisation de la prise rap Case "6" ! +chr fin de page rap Case "7" ! ignorer ' 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 $S% 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 @Emtechinfo("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 If Emulm|<>0 @Emtechinfo("40 colonnes ->") ' If Emulm|<>0 ' If Emulm|<>0 If @Answer Fsend(Chr$(19)+"^") ! ‚tat standard 40 col Endif ' Gosub Emulm(0) ' Em_d!=-1 ! redraw If Em_fl! Gosub Vcls_draw Endif ' Endif ' Endif Endif ' Case &H3A317D ! 80am If Emulm|<>2 @Emtechinfo("80 colonnes, am‚ricain ->") ' Gosub Rep_ini80 If @Answer Fsend(Chr$(27)+"[?z") ! renvoi 80 col! Endif ' Gosub Emulm(2) ! 80 col ' Em_d!=-1 ! redraw If Em_fl! Gosub Vcls_draw Endif Endif ' Case &H3A327D ! 80fr If Emulm|<>1 @Emtechinfo("80 colonnes, fran‡ais ->") Gosub Rep_ini80 ' Gosub Emulm(1) ! 80 col ' Em_d!=-1 ! redraw If Em_fl! Gosub Vcls_draw Endif Endif ' Case &H3A6F31 ! (Esclave) @Emtechinfo("Esclave -") ! ne r‚pond rien Case &H3A7259 ! (Status clavier) @Emtechinfo("Demande status clavier ->") Gosub Rep_clav Case &H3A7C6A ! (Lprint fr) @Emtechinfo("Lprint: fr.") Case &H3A7C6B ! (Lprint am) @Emtechinfo("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(em_fl!) ' If em_fl! ' 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 ! ?? ' ??? ' print "inconnu" Em_a&=-1 ' ' Case &H22223C ! esc+""< Ouize tarif en sortie t‚l‚tel ' ' ------------------------------ 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) @Emtechinfo("Demande status module ->") Gosub Rep_aig(Spe|(2)) Case &H3A6400 ! (Ack protocole/diffusion) @Emtechinfo("Ack protocole/diffusion.") Case &H3A6500 ! (Idem) @Emtechinfo("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 @Emtechinfo("Mode rouleau.") Gosub Rep_fonct Endif Case "D" ! PCE @Emtechinfo("Lancement fonctionnement PCE.") Gosub Rep_fonct Case "E" ! Min @Emtechinfo("Lancement fonctionnement min.") ' ' ~Bios(11,Bclr(Bios(11,-1),4)) Gosub Rep_fonct Case "F" ! Loupe h @Emtechinfo("Lancement fonctionnement loupeH.") Case "G" ! Loupe b @Emtechinfo("Lancement fonctionnement loupeB.") Default @Emtechinfo("Lancement fonctionnement ??? .") Endselect ' Case &H3A6A00 ! (Arrˆt fonct) ' Select Spe|(2) Case "C" ! rouleau If Emulm|=0 Rmode!=False @Emtechinfo("Mode rouleau d‚sactiv‚.") Gosub Rep_fonct Endif Case "D" ! PCE @Emtechinfo("Arrˆt fonctionnement PCE.") Gosub Rep_fonct Case "E" ! Min @Emtechinfo("Arrˆt fonctionnement min. (MAJ)") ' '~Bios(11,Bset(Bios(11,-1),4)) Gosub Rep_fonct Case "F" ! Loupe h @Emtechinfo("Arrˆt fonctionnement loupeH.") Case "G" ! Loupe b @Emtechinfo("Arrˆt fonctionnement loupeB.") Default @Emtechinfo("Arrˆt fonctionnement ???") Endselect ' Case &H3A7100 ! (R‚p stat term) If (Not Set_send!) If Btst(Spe|(2),3)<>Connect! If (Not Hsm!) Connect!=Not Connect! Endif Gosub Xconnect Gosub Test_menu If Connect! @Eminfo("Connexion") Else @Eminfo("D‚connexion") Endif If Em_fl! Vdraw(F_c&,0) Else Vidrd|(F_c&,0)=&HFF ! redraw quand mˆme ? Endif Else If Connect! @Eminfo("Connect‚") Else @Eminfo("D‚connect‚") Endif Endif Endif Case &H3A7300 ! (R‚p stat fonct) @Emtechinfo("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) @Emtechinfo("R‚ponse status vitesse") Case &H3A7700 ! (R‚p stat protocole) @Emtechinfo("R‚ponse status protocole") ' Case &H222200 ! Exit If (Not Set_send!) @Tarif("/"+Chr$(18+Spe|(2))) Endif ' Default Select Rol(Spe|(0),8)+Spe|(2) Case &H2030 ! PAVI - num‚rotation If (Not Set_send!) @Tarif(Chr$(18+Spe|(1))) Endif ' ' Case &H223C ' Default Select Spe|(0) Case &H3A ! PRO2 - 2 params donc exit ' Case &H20 ! IAN suite Em_a&=-1 ' 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 phase) 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) @Emtechinfo("R‚ponse status clavier (‚tendu)") Else @Emtechinfo("R‚ponse status clavier (normal)") Endif ' Case &H3B6959 ! Programmation du clavier @Emtechinfo("Programmation du clavier") If @Answer Fsend(Pro3$+"sY"+Chr$(Spe|(3))) Endif Case &H3B6A59 ! @Emtechinfo("D‚programmation du clavier") If @Answer Fsend(Pro3$+"sY@") Endif ' Case &H3B695A,&H3B6A5A Em_a&=-1 ! 3B 69 5A 41 et 3B 6A 5A 41 ' ' Case &H212121 ! ESC+!!!%0 (inconnu) trait‚ aprŠs ' Em_a&=-1 ' ' 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 @Emtechinfo("Arrˆt aiguillage") Case &H6100 @Emtechinfo("Lancement aiguillage") Endselect ' Gosub Rep_aig(Spe|(2)) ' Case &H3B6300 ! r‚ponse status module @Emtechinfo("R‚ponse status module") ' Default Select Rol(Spe|(0),8)+Spe|(3) Case &H2030 ! IAN invitation … num‚roter+pallier ?? ' ??? If (Not Set_send!) ' print Chr$(18+Spe|(1))+Chr$(18+Spe|(2)) Endif ' Case &H2130 ! tarification / "indication de connexion r‚ussie" If (Not Set_send!) @Tarif(Chr$(Spe|(1)+16)+Chr$(Spe|(2)+16)) Endif ' ' euh non gour‚ de nb params ' Case &H2030 ! invitation … num‚roter ' If (Not Set_send!) ' @Tarif("!") ! echec cnx, pallier 0 ' Endif ' Default Select Spe|(0) Case &H3B ! PRO3 - 3 params donc exit ' Case &H21 ! Parfois on a des 212123252530 !! ' ou 21 2X 2Y 2Z 2T 30 Em_a&=-1 ! continue.. ' Default Clr Special& Endselect Endselect Endselect Endselect Default Clr Special& Endselect ' ' ------------------------------ Case 4 ! 5 params - PRO+4 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 if Special&=27 Select Rol(Spe|(0),24)+Rol(Spe|(1),16)+Rol(Spe|(2),8)+Spe|(3) Case &H3B695A41,&H3B6A5A41 ! XON/XOFF non g‚r‚.. @Emtechinfo("XON/XOFF ->") ' ' Case &H21212125 ! ESC+!!!%0 (inconnu) ' Clr Special& ' Default Select Spe|(0) Case &H21 ! ESC+!!!%0 (inconnu) AND CO ' If Spe|(4)=&H30 ' Commande inconnue au bataillon.. ' ESC - 21 - 2X 2Y 2Z - 30 ' If Inftech! @Emtechinfo("Esc $"+Hex$(Spe|(0),2)+" $"+Hex$(Spe|(1),2)+" $"+Hex$(Spe|(2),2)+" $"+Hex$(Spe|(3),2)+" $"+Hex$(Spe|(4),2)+" $"+Hex$(Spe|(5),2)) Endif ' ' Arrive parfois lorsque l'on change de serveur (peut ˆtre utile pour tarification) If (Not Set_send!) If Connect! If Pal1cnx&<=0 And Pal0cnx&=>0 ! pas de pallier 1 Chk_tar ! tarif affich‚?.. Endif Endif Endif Endif ' Default Clr Special& Endselect Endselect Else Clr Special& Endif ' ' ------------------------------ Case 5 ! 6 params (exceptionnel!!) ' ------------------------------ ' If Special&=31 ! US $S% 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'" @Emtechinfo("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'" @Emtechinfo("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 @Emtechinfo("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 Em_fl! ' If Em_d!=-1 ' Rd_all(4,W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) ' Endif ' Endif Endif ' Return $P> ' Procedure Echar(Var X&,Y&,C&,Flag!) ' Local T& ' $S& Lastc|=Byte(C&) Ec_t&=Tcurs| If Emulm|=0 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 ' Else ! terminal, si 0 normal If Vidterm|(Y&)<>0 Ec_t&=Vidterm|(Y&)+10 Else Clr Ec_t& Endif Endif ' ' *** If Em_trx! ! transfert en cours vdt2ascii Ech_trx(C&) Endif ' 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+2),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 ' Case 13,14 C&=C& Or 3*&H100 ! Attrb taille ' If Ec_t&=13 ! haut Ecfix(X&,Y&,Bset(C&,8+2),Flag!) Ecfix(X&+1,Y&,Bset(Bset(C&,8+2),8+3),Flag!) Else Ecfix(X&,Y&,C&,Flag!) ! Fixer char c en xy avec col et attrbS Ecfix(X&+1,Y&,Bset(C&,8+$ And And And And Eqv And ),Flag!) Endif Add X&,2 If X&=>Vmax_x& X&=Vmax_x&-1 Endif ' ' Case 16 ! dble largeur C&=C& Or 2*&H100 ! Attrb taille ' 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& X&=Vmax_x&-1 Endif ' Endselect $S% ' Return $P< Procedure Echar00 ' Local T& ' $S& Lastc|=Byte(Em_c&) If Emulm|=0 Ec_t&=Tcurs| If Y_curs&<=0 Select Ec_t& Case 1,3 ! Impossible en L0 Clr Ec_t& Endselect Else if X_curs&=>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_curs&=0 ! Pos 1,XX ; pas de fond possible alors If Em_c&<>32 ! Pas esp ' Texte en plus? ' If Not Btst(Vida|(X_curs,y_curs),4) If Not Btst(Acurs|,4) Ccurs&=And(Ccurs&,&HFF00) Endif Endif Else if Btst(Acurs|,4) Clr Ec_t& ! Graphique taille normale Endif ' Else ! terminal, si 0 normal If Vidterm|(Y&)<>0 Ec_t&=Vidterm|(Y&)+10 Else Clr Ec_t& Endif Endif ' ' *** If Em_trx! ! transfert en cours vdt2ascii Ech_trx(Em_c&) Endif Em_c&=Em_c& Or Ec_t&*&H100 ! Attrb taille Select Ec_t& Case 0 ! Normale ' Ecfix(X_curs&,Y_curs&,Em_c&,Em_fl!) ! Fixer char c en xy avec col et attrbS Ecfix00 Inc X_curs& If X_curs&>Vmax_x& If Y_curs&<>0 And Emulm|=0 X_curs&=0 Inc Y_curs& Else X_curs&=Vmax_x& Endif If Y_curs&>Vmax_y& Y_curs&=@Ynewcurs(1,Em_fl!) ! curs=1 ou scroller! ' y_curs=1 ' Ccurs&=And(Ccurs&,&HFF00) ???? mais non!! on garde le fond! Endif ' Gosub Xvdt_setme(X_curs&,Y_curs&) ! comme vdt_setme mais avec x& et y& Gosub Xvdt_setme00 Endif ' Case 1 ! Haut ' Ecfix(X_curs&,Y_curs&,Em_c&,Em_fl!) ! Fixer char c en xy avec col et attrbS Ecfix00 Ecfix(X_curs&,Y_curs&-1,Bset(Em_c&,8+2),Em_fl!) Inc X_curs& If X_curs&>Vmax_x& If Y_curs&<>0 And Emulm|=0 X_curs&=0 Add Y_curs&,2 Else X_curs&=Vmax_x& Endif If Y_curs&>Vmax_y& ' y_curs=2 Y_curs&=@Ynewcurs(2,Em_fl!) ' Ccurs&=And(Ccurs&,&HFF00) ????? Endif ' Gosub Xvdt_setme(X_curs&,Y_curs&) ! comme vdt_setme mais avec x& et y& Gosub Xvdt_setme00 Endif ' Case 2 ! Large ' Ecfix(X_curs&,Y_curs&,Em_c&,Em_fl!) ! Fixer char c en xy avec col et attrbS Ecfix00 Ecfix(X_curs&+1,Y_curs&,Bset(Em_c&,8+$ And And And And Eqv And ),Em_fl!) Add X_curs&,2 If X_curs&>Vmax_x& If Y_curs&<>0 And Emulm|=0 X_curs&=0 Inc Y_curs& Else X_curs&=Vmax_x& Endif If Y_curs&>Vmax_y& ' y_curs=1 Y_curs&=@Ynewcurs(1,Em_fl!) ! curs=1 ou scroller! ' Ccurs&=And(Ccurs&,&HFF00) ?????? Endif ' Gosub Xvdt_setme(X_curs&,Y_curs&) ! comme vdt_setme mais avec x& et y& Gosub Xvdt_setme00 Endif ' Case 3 ! Dble taille ' Ecfix(X_curs&,Y_curs&,Em_c&,Em_fl!) ! Fixer char c en xy avec col et attrbS Ecfix00 Ecfix(X_curs&,Y_curs&-1,Bset(Em_c&,8+$ And And And And Eqv And ),Em_fl!) Ecfix(X_curs&+1,Y_curs&,Bset(Em_c&,8+3),Em_fl!) Ecfix(X_curs&+1,Y_curs&-1,Bset(Bset(Em_c&,8+2),8+3),Em_fl!) Add X_curs&,2 If X_curs&>Vmax_x& If Y_curs&<>0 And Emulm|=0 X_curs&=0 Add Y_curs&,2 Else X_curs&=Vmax_x& Endif If Y_curs&>Vmax_y& ' y_curs=2 Y_curs&=@Ynewcurs(2,Em_fl!) ! curs=2 ou scroller! ' Ccurs&=And(Ccurs&,&HFF00) ?????? Endif Endif ' Case 13,14 C&=C& Or 3*&H100 ! Attrb taille ' If Ec_t&=13 ! haut Ecfix(X_curs&,Y_curs&,Bset(C&,8+2),Flag!) Ecfix(X_curs&+1,Y_curs&,Bset(Bset(C&,8+2),8+3),Flag!) Else Ecfix(X_curs&,Y_curs&,C&,Flag!) ! Fixer char c en xy avec col et attrbS Ecfix(X_curs&+1,Y_curs&,Bset(C&,8+$ And And And And Eqv And ),Flag!) Endif Add X_curs&,2 If X_curs&=>Vmax_x& X_curs&=Vmax_x&-1 Endif ' ' Case 16 ! dble largeur C&=C& Or 2*&H100 ! Attrb taille ' Ecfix(X_curs&,Y_curs&,C&,Flag!) ! Fixer char c en xy avec col et attrbS Ecfix(X_curs&+1,Y_curs&,Bset(C&,8+3),Flag!) Add X_curs&,2 If X_curs&=>Vmax_x& X_curs&=Vmax_x&-1 Endif ' Endselect $S% ' Return $P> ' ' Rien … voir: sauver caractŠre si texte Procedure Ech_trx(C&) ' Sauver caractŠre? C&=Byte(C&) If C&=127 ! obliter, =espace C&=32 Endif If Emulm|>0 Or (Not Btst(Acurs|,4)) If Y_curs&>0 If Y_curs&<>Trx_y& Or C&=0 Trl$=@Rtrim$(Trl$) If Y_curs&>Trx_y& Trx$=Trx$+Trl$+String$(Min(12,Y_curs&-Trx_y&),Chr$(13)+Chr$(10)) Else Trx$=Trx$+Trl$+Chr$(13)+Chr$(10) Endif Clr Trl$ Else if X_curs&>Trx_x&+1 If Len(Trl$)<80 Trl$=Trl$+Space$(X_curs&-Trx_x&-1) Else Trl$=Trl$+" " Endif Else if X_curs&0 Trl$=Trl$+Chr$(C&) ! sauver ligne Endif If Len(Trl$)>80 Trl$=@Rtrim$(Trl$) Trx$=Trx$+Trl$+Chr$(13)+Chr$(10) Clr Trl$ Endif Trx_x&=X_curs& Trx_y&=Y_curs& Endif Endif Return ' ' Procedure Ecfix(X&,Y&,C&,Flag!) ' Vidp|(X&,Y&)=0 ! Effacer mosa‹que photographique ‚ventuelle 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 ' euh … voir... ' ' ??????????????????????????????????????????????????? ' ' If And(Vida|(X&+1,Y&),&X1000000)=0 ! si en graph, startcolor sont propag‚s ' Gosub Propage(X&+1,Y&,Flag!) ' Endif Else if Btst(Vida|(X&,Y&),4) ! si avant en graph, et TEXTE aprŠs, propager OUF!! (Path‚) If Not Btst(Vida|(X&+1,Y&),4) ' mode texte avec graph aprŠs 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 Vidc&(X&,Y&)=Ccurs& ! voui Vt100!! Endif If Flag! Gosub Vdraw(X&,Y&) Else Vidrd|(X&,Y&)=&HFF ! redraw quand mˆme ? Endif ' Return $P< Procedure Ecfix00 ' Vidp|(X_curs&,Y_curs&)=0 ! Effacer mosa‹que photographique ‚ventuelle Vids&(X_curs&,Y_curs&)=Em_c& If Emulm|=0 Vidc&(X_curs&,Y_curs&)=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_curs&,Y_curs&),5) ! starter!! (il s'annulera aprŠs) ' ' Propager, mais en couleur 0 If And(Vida|(X_curs&+1,Y_curs&),&X1100000)=0 ' Gosub Propagen(X_curs,y_curs,em_fl!) Gosub Propage(X_curs&+1,Y_curs&,Em_fl!) ' ' Eh non!!!! CF VDT_SETME/XVDT_SETME ' ' Gosub Propage0(X_curs,y_curs,em_fl!) ! +1 (‚liminer starter) Endif ' Else if Cnext|<>&HFF ! couleur prochaine ' Propager, normalement If And(Vida|(X_curs&+1,Y_curs&),&X1100000)=0 ' Gosub Propagen(X_curs,y_curs,em_fl!) Gosub Propage(X_curs&+1,Y_curs&,Em_fl!) Endif ' Else if Btst(Acurs|,4) ! graphique ' If And(Vida|(X_curs+1,y_curs),&X1100000)=0 ' euh … voir... ' ' ??????????????????????????????????????????????????? ' ' If And(Vida|(X_curs+1,y_curs),&X1000000)=0 ! si en graph, startcolor sont propag‚s ' Gosub Propage(X_curs+1,y_curs,em_fl!) ' Endif Else if Btst(Vida|(X_curs&,Y_curs&),4) ! si avant en graph, et TEXTE aprŠs, propager OUF!! (Path‚) If Not Btst(Vida|(X_curs&+1,Y_curs&),4) ' mode texte avec graph aprŠs Gosub Propage(X_curs&+1,Y_curs&,Em_fl!) Endif ' Endif ' ' If Btst(Acurs|,4) ! graph Vida|(X_curs&,Y_curs&)=Bset(Acurs|,6) ! avec une d‚claration d'inhibition! Else Vida|(X_curs&,Y_curs&)=Acurs| Endif ' Else Vida|(X_curs&,Y_curs&)=Acurs| ! 80 col Endif If Em_fl! ' Gosub Vdraw(X_curs&,Y_curs&) Gosub Vdraw00 Else Vidrd|(X_curs&,Y_curs&)=&HFF ! redraw quand mˆme ? Endif ' Return $P> ' 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 If True ! XXXXXX NON AU CONTRAIRE remplacera alors ' 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 $P< Procedure Ecatest00 ' teste si la couleur du caractŠre pr‚c‚dent doit ˆtre activ‚e par ex ' If Emulm|=0 If X_curs&>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 If True ! NON AU CONTRAIRE remplacera alors ' attrb/col <>? If (Byte(Vidc&(X_curs&-1,Y_curs&))<>Byte(Ccurs&)) Or (Btst(Acurs|,1)<>Btst(Vida|(X_curs&-1,Y_curs&),1)) ' Ccurs&=And(Ccurs&,&HFF00) Or Byte(Vidc&(X_curs&-1,Y_curs&)) Acurs|=Bclr(Bclr(Acurs|,5),1) If Not Btst(Vida|(X_curs&-1,Y_curs&),4) ! <>graph If Btst(Vida|(X_curs&-1,Y_curs&),1) Acurs|=Bset(Acurs|,1) Endif Endif ' Endif Endif Endif Endif ' Endif Endif Endif ' Return $P> ' ' Calcul des coord photo $P< Procedure P_calc ' Formules de conversion XYWH en coord vid‚otex ' Point origine (loc,ppl) ' *319 mˆme pour y,h car offset max r‚gl‚ … 0.75 (0.75*320=240) P_ox&=1+((((P_loch#+P_offh#)*319)+4) Div 8) P_oy&=24-((((P_locv#+P_offv#)*319)+5) Div 10) ' Photo area location (loc) P_x&=1+(((P_loch#*319)+4) Div 8) P_y&=24-(((P_locv#*319)+5) Div 10) ' Dimensions de la zone photographique (pas), h=horizontal w=vertical!!! P_w&=(((P_sizh#*319)+4) Div 8) P_h&=(((P_sizw#*319)+5) Div 10) ' ' Pour nous, gauche =0 et pas 1 Dec P_x& Dec P_ox& ' ' Ca, c'est bizzard! M'enfin bon.. Inc P_y& Inc P_oy& Return $P> ' Procedure Modcut ' ~@Infow(4,"/D‚connexion physique") If Rsdev&<>9999 If Set_speed! Outvid(Pro1$+"g") Pause 10 Else Atsend(Modem$(3)) Pause 10 Endif ' If Hsm! ! HSMODEM! Gosub Connect Else Connect!=False Gosub Xconnect Gosub Test_menu If Wopen!(4) @Sw_clip Vdraw(F_c&,0) Endif Endif Else @Inet_close Endif ' Return ' ' Ecriture d'un bloc aprŠs une erreur.. Procedure Pe_write(Adr%,Len%,E$) Local N& Local Fileh& Local A$ ' If Fichp! ! autoris‚? Gosub Defmouse(2) ' If Len(E$)=0 E$="Fichier non trait‚" Endif ' ' Dossier cr‚‚? If Fsfirst(Set_path$+"REPORT",&H10)=-33 A$=Set_path$+"REPORT"+Chr$(0) ~Gemdos(57,L:V:A$) Endif If Fsfirst(Set_path$+"REPORT\RECEPT",&H10)=-33 A$=Set_path$+"REPORT\RECEPT"+Chr$(0) ~Gemdos(57,L:V:A$) Endif ' ' BLOC0001.DAT BLOC0002.DAT etc.. N&=1 Clr A$ A$=Set_path$+"REPORT\RECEPT\"+"BLOC"+@Xstr$(N&,4)+".DAT"+Chr$(0) While Fsfirst(A$,0)=0 Inc N& A$=Set_path$+"REPORT\RECEPT\"+"BLOC"+@Xstr$(N&,4)+".DAT"+Chr$(0) Wend ' If Len%=>0 A$=Set_path$+"REPORT\RECEPT\"+"BLOC"+@Xstr$(N&,4)+".DAT"+Chr$(0) Fileh&=@Fcreate(A$,0) If @Tsterr(Fileh&) ~@Tsterr(@Fadrwrite(Fileh&,Adr%,Len%)) ~@Tsterr(@Fclose(Fileh&)) Endif Else E$=E$+Cr$+"* Erreur, fichier vide ou corrompu"+Cr$ Endif ' A$=Set_path$+"REPORT\RECEPT\"+"BLOC"+@Xstr$(N&,4)+".TXT"+Chr$(0) Fileh&=@Fcreate(A$,0) If @Tsterr(Fileh&) ~@Tsterr(@Fadrwrite(Fileh&,V:E$,Len(E$))) ~@Tsterr(@Fclose(Fileh&)) Endif ' Gosub Defmouse(0) Endif ' Return ' ' ' ' Connexion Procedure Xconnect Local N& Local E$ ' If Connect! If Timecnx%<=0 ' If Lastsend|<=0 Lastsend|=10 ! on vient d'envoyer Endif ' Pal1cnx&=-1 Clr Red1cnx! Accpal!=False Timecnx%=Gemdos(44) If Pal0cnx&=>0 If Pal0cnx&>0 E$="Connexion, " If Red0cnx! E$=E$+Str$((Pal0cnx&*Redcnx%)/10000,6,2)+"F/min ("+Str$(Redcnx%,3,0)+"%)" Else E$=E$+Str$(Pal0cnx&/100)+"F/min" Endif Else E$="Connexion" Endif Gosub Eminfo(E$) Gosub Outlog(E$) Else Gosub Eminfo("Connexion (tarification inconnue)") Gosub Outlog("Connexion (tarification inconnue)") Endif ' @Beep Timecoast%=0 ! facture totale en centimes Timecount%=Gemdos(44) ! temps total ' Rst_seq ! reset sequence! Endif Else If Timecnx%>0 ' If Lastsend|<=0 Lastsend|=10 ! on vient d'envoyer Endif ' Gosub Facture Gosub Outlog("D‚connexion") @Beep Pal0cnx&=-1 Pal1cnx&=-1 Clr Red0cnx!,Red1cnx! Accpal!=False Clr Pavi$,Callpav$,Pal1$ ! service composition autom. & co Clr Timecnx% ' Rst_seq ! reset sequence! ' Endif Endif Return ' Gestion tirelire Procedure Tarif(E$) Local X$ ' ' Pal1cnx&=>0 Pallier 1 (service) c/minute ' Pal2cnx&=>0 Pallier 0 (t‚l‚tel) ' If Inftech! @Emtechinfo("R‚ception SYNC "+E$) Endif ' If Len(E$)=2 And Left$(E$,1)<>"/" If Timecnx%>0 Gosub Facture Endif Timecnx%=Gemdos(44) ' Pal1cnx&=-1 Clr Red1cnx! Accpal!=False ' Redcnx%=100 ' A$=@Finput$("TARIFS.SET") A$=Tarif$ While Len(A$)>0 B$=Upper$(Trim$(@Ntrim$(@Flin$(A$)))) Gosub Reduction(B$) ! est-ce une r‚duc? N&=Instr(B$," ") If N&>0 If Left$(B$,N&-1)="T"+E$ ! pallier reconnu! B$=@Xtrim$(Mid$(B$,N&+1)) Red1cnx!=False If Right$(B$,1)="+" ! r‚ductions en fction du temps! Red1cnx!=True Endif If Left$(B$,1)="*" ! raquer en plus 12c Pal1cnx&=Val(Mid$(B$,2)) ! pallier un (services) Accpal!=True Else Pal1cnx&=Val(B$) ! pallier un (services) Accpal!=False Endif Pal1$="T"+E$ ! pallier Clr A$ ! exit Else Clr N& Endif Endif Wend ' X$="#Tarification T"+E$+" (" If Pal1cnx&>0 If Accpal! X$=X$+Str$(Acccnx&)+"F"+" + " Endif If Red1cnx! If Redcnx%<>100 X$=X$+Str$((Pal1cnx&*Redcnx%)/10000,6,2)+"F/min)"+" "+Str$(Redcnx%)+"%" Else X$=X$+Str$(Pal1cnx&/100)+"F/min)" Endif Else X$=X$+Str$(Pal1cnx&/100)+"F/min)" Endif @Eminfo(X$) Else if Pal1cnx&=0 If (Not Accpal!) X$=X$+"gratuit)" Else X$=X$+Str$(Acccnx&/100)+"F"+"'gratuit')" Endif @Eminfo(X$) Else ' Pal0cnx&=-1 X$=X$+"inconnu, Cf: TARIFS.SET)" @Eminfo(X$) ' ' Si le prix est affich‚... Gosub Chk_tar ' Endif ' ' Else if Len(E$)=1 Else ' Nan, il se peut qu'un service nous envoie une invitation … num‚roter ' sans pour autant ˆtre le pallier t‚l‚tel!! ' ' SISISISISISI (..) XXXXXXXXXXXXXXXX ' ' If Len(E$)=2 ! retour t‚l‚tel ' If False ' ' euh ' ' Else ! echec, d‚connexion etc. -> retour pallier ' ' ???? ' If Callcnx$<>"361"+E$ Or Pal1cnx&=>0 ????????? ' If Pal1cnx&=>0 ! pallier 1 -> pallier 0 If Timecnx%>0 Gosub Facture Endif ' ' Pal1cnx&=-1 ! pallier 0 Clr Red1cnx! Accpal!=False Timecnx%=Gemdos(44) Endif ' If Len(E$)=1 ! IAN 361X Callcnx$="361"+E$ If Len(Pavi$)=0 @Eminfo("Veuillez entrer le code t‚l‚tel "+Callcnx$) ' ' Certains services sont bizzards: IAN au lieu de tarification.. ' If A! ' Gosub Chk_tar ' Endif ' Else If Pal1cnx&<0 If Prix! Send(Pavi$+Sep$+"F") ! aff prix Endif @Eminfo("Code t‚l‚tel "+Callcnx$+": "+Pavi$) Send(Pavi$+Sep$+"A") Callpav$=Pavi$ Else ! on est sur un pallier! Clr Callpav$ Endif Clr Pavi$ Endif Endif ' Gosub Tar0 ! tarif pallier 0 actuel X$="T‚l‚tel "+Callcnx$+" (" If Pal0cnx&=>0 X$=X$+Str$(Pal0cnx&/100)+"F/min)" If Red0cnx! ! r‚ductions? If Redcnx%<>100 X$=X$+" "+Str$(Redcnx%)+"%" Endif Endif Else X$=X$+"inconnu, Cf: TARIFS.SET)" Endif Outlog(X$) ' Endif ' Endif ' Endif ' Return Procedure Reduction(E$) Local R&,X&,Y&,Z& Local A$,B$ ' If Left$(E$,6)="REDUC " B$=Time$ A$=@Lft$(E$) ! partie droite R&=Val(A$) A$=@Lft$(E$) If Len(A$)=8 ! heure If Val(Mid$(B$,1,2))*3600+Val(Mid$(B$,4,2))*60+Val(Mid$(B$,7,2))<=Val(Mid$(A$,1,2))*3600+Val(Mid$(A$,4,2))*60+Val(Mid$(A$,7,2)) A$=@Lft$(E$) If Len(A$)=8 ! heure If Val(Mid$(B$,1,2))*3600+Val(Mid$(B$,4,2))*60+Val(Mid$(B$,7,2))=>Val(Mid$(A$,1,2))*3600+Val(Mid$(A$,4,2))*60+Val(Mid$(A$,7,2)) ' print "Detect‚.. ";R&;"%" Redcnx%=R& Endif Endif Endif Endif Endif ' Return Procedure Facture Local N&,T% ' N&=(@Timsec(Gemdos(44))-@Timsec(Timecnx%)) ! secondes ' If Pal1cnx&=>0 T%=N&*Pal1cnx& ! prix pallier service actuel en sec.cent.min^-1 If Red1cnx! T%=(T%*Redcnx%)/100 ! r‚duction ‚ventuelle Endif Else if Pal0cnx&=>0 Clr Pal1$ ' Chez FT, on ne facture pas … l'entr‚e T‚l‚tel, mais … la sortie!! :-)) If Timecoast%>0 Or Len(Callcnx$)>4 ! non 361x T%=N&*Pal0cnx& ! prix pallier 0 (mire t‚l‚tel..) If Red0cnx! T%=(T%*Redcnx%)/100 ! r‚duction ‚ventuelle Endif Else Clr T% Endif Else Clr Pal1$ T%=-1 Endif If T%=>0 If Mod(T%,60)=0 T%=T%\60 ! /60sec -> cent.min^-1 Else T%=T%\60+1 ! en centimes Endif ' If Accpal! ! +0.12c pour accŠs r‚seau T%=T%+Acccnx& Endif Endif ' If Len(Pal1$)>0 Pal1$=" ("+Pal1$+")" Endif If T%=>0 If Inftech! Gosub Outlog("["+Callcnx$+" "+Callpav$+Pal1$+" "+@Ntim$(Timecnx%)+" "+Str$(T%/100,6,2)+"]") Endif Timecoast%=Timecoast%+T% ! en centimes ' Timecount court toujours.. Else If Inftech! Gosub Outlog(Callcnx$+" "+Callpav$+Pal1$+" "+@Ntim$(Timecnx%)+" ?? FF") Endif Endif Clr Pal1$ ' If (Not Connect!) ! facture de la connexion ' Tarification par unit‚s indivisibles ' (r‚alis‚ APRES (tout de mˆme!)) If Mod(Timecoast%,Unitcnx&)=0 Timecoast%=(Timecoast%\Unitcnx&)*Unitcnx& Else Timecoast%=(Timecoast%\Unitcnx&+1)*Unitcnx& Endif If Inftech! Gosub Outlog(" "+@Ntim$(Timecount%)+" "+Str$(Timecoast%/100,6,2)+" FF") Endif Gosub Outcom(Date$+" "+Time$+" "+Callcnx$+Space$(Max(1,$ And And And And Eqv Eqv -Len(Callcnx$)))+@Ftim$(Timecount%)+" "+Trim$(Str$(Timecoast%/100,6,2))) Gosub Eminfo("Fin de communication, "+Trim$(Str$(Timecoast%/100,6,2))+"FF TTC en "+@Ftim$(Timecount%)) ' Clr Timecoast% Endif ' Return ' Prix total actuel Function Facpr $F% Local N&,T% ' N&=(@Timsec(Gemdos(44))-@Timsec(Timecnx%)) ! secondes If Pal1cnx&=>0 T%=N&*Pal1cnx& ! prix pallier service actuel en sec.cent.min^-1 If Red1cnx! T%=(T%*Redcnx%)/100 ! r‚duction ‚ventuelle Endif Else if Pal0cnx&=>0 ' Chez FT, on ne facture pas … l'entr‚e T‚l‚tel, mais … la sortie!! :-)) If Timecoast%>0 Or Len(Callcnx$)>4 ! non 361x ' If Timecoast%>0 T%=N&*Pal0cnx& ! prix pallier 0 (mire t‚l‚tel..) If Red0cnx! T%=(T%*Redcnx%)/100 ! r‚duction ‚ventuelle Endif Else Clr T% Endif Else T%=-1 Endif If T%>0 ! (si=0 rap) If Mod(T%,60)=0 T%=T%\60 ! /60sec -> cent.min^-1 Else T%=T%\60+1 ! en centimes Endif ' If Accpal! ! +0.12c pour accŠs r‚seau T%=T%+Acccnx& Endif ' Else Clr T% Endif ' ' par unit‚s T%=T%+Timecoast% If Mod(T%,Unitcnx&)=0 T%=(T%\Unitcnx&)*Unitcnx& Else T%=(T%\Unitcnx&+1)*Unitcnx& Endif ' Return T% Endfunc ' ' V‚rifier tarification en ligne 0 (si non reconnue etc) Procedure Chk_tar Local X& Local E$,X$ Local N&,Z& Local F&,C& Local A# ' If Pal1cnx&<=0 And Pal0cnx&=>0 Clr E$ X&=0 While X&<=Vmax_x&-12 ! moins le prix Select Vids&(X&,0) Case ",","." E$=E$+"." Case "O" ! quels cons chez FT.. E$=E$+"0" Case " ","a" To "z","A" To "Z","0" To "9","'","`","_","ø",":","!",34,"#","]","[","{","}","/","\","-" E$=E$+Chr$(Vids&(X&,0)) Default Exit if True Endselect Inc X& Wend E$=Upper$(Trim$(E$)) ' If Len(E$)>0 If Left$(E$,1)="T" And Right$(E$,5)="F/MIN" ! Txx ? E$=Mid$(E$,2) Z&=Val?(E$) If Z&<=3 And Z&>0 ! Txx ou Tx ' N&=Instr(E$," ") If N&>0 E$=Trim$(Mid$(E$,N&)) If Len(E$)>0 ' Accpal!=False Red1cnx!=False ! pas de r‚duc, d‚ja compris!! N&=Instr(E$,"PUIS") If N&>0 Accpal!=True E$=Trim$(Mid$(E$,N&+4)) Endif ' Z&=Val?(E$) If Z&>0 A#=Val(Mid$(E$,1,Z&))*100 ! centimes Pal1cnx&=Round(A#) ! prix effectif ' If Pal1cnx&=>0 X$="#Tarification reconnue (" If Accpal! X$=X$+Str$(Acccnx&)+"F"+" + " Endif If Red1cnx! If Redcnx%<>100 X$=X$+Str$((Pal1cnx&*Redcnx%)/10000,6,2)+"F/min)"+" "+Str$(Redcnx%)+"%" Else X$=X$+Str$(Pal1cnx&/100)+"F/min)" Endif Else X$=X$+Str$(Pal1cnx&/100)+"F/min)" Endif ' @Eminfo(X$) ' Endif Endif ' ' Endif Endif Endif Endif Endif Endif ' ' @Tarif("/"+Chr$(18+Spe|(2))) Return ' ' Procedure Dial(E$) Local N&,A&,B&,C& ' N&=Rinstr(E$,Chr$(1)) If N&>0 If Len(E$)-N&=4 Or Len(E$)-N&=6 A&=Val("$"+Mid$(E$,N&+1,2)) ! config B&=Val("$"+Mid$(E$,N&+1+2,2)) ! config C&=Val("$"+Mid$(E$,N&+1+4,2)) ! mode ~Xbios(15,-1,B&,A&,-1,-1,-1) ! RSCONF Select C& Case 1 ! vdt If Emulm|<>0 @Eminfo("Passage en mode vid‚otex & chg. config") Emulm(0) Else @Eminfo("Chg. config") Endif Case 2 ! term. If Emulm|<>3 @Eminfo("Passage en mode terminal (type VT-100) & chg. config") Emulm(3) Else @Eminfo("Chg. config") Endif Default @Eminfo("Chg. config") Endselect Endif E$=Left$(E$,N&-1) Endif ' N&=Instr(E$,"/") If N&>0 Pavi$=Mid$(E$,N&+1) ! code service ' Callpav$=Pavi$ E$=Left$(E$,N&-1) Else Clr Pavi$,Callpav$ Endif ' Clr Pal0cnx&,Pal1cnx& Clr Red0cnx!,Red1cnx! Pal0cnx&=-1 Pal1cnx&=-1 Accpal!=False Gosub Defmouse(2) If Len(Callinf$)>0 ~@Infow(4,"/Appel: "+Callinf$+" ("+E$+" "+Pavi$+")") Clr Callinf$ Else ~@Infow(4,"/Appel: "+E$+" "+Pavi$) Endif Callcnx$=@Xtrim$(E$) If Rsdev&<>9999 If Set_speed! Outvid(Pro1$+"S") Pause 5 Outvid(Pro3$+"a\S") Pause 10 ' Outvid(Pub$+E$) Atsend(Pub$+E$) ! num‚ro ATSEND!! (norme , \xx etc) Pause 15 Outvid(Pro1$+"h") Else Atsend(Modem$(4)) ! prise de ligne Outvid(Pub$+E$) ! num‚ro direct Atsend(Modem$(2)) ! connect Endif Else ! internet If Pavi$<>"" ~@Inet_connect(Pavi$,E$) Clr Pavi$,Callpav$ Else ~@Form_alert(1,"[3][Erreur de num‚ro via Internet|Le num‚ro doit ˆtre sous la|forme adresse:port/service|Ex: winnt.rtel.fr:516/RTEL][Annuler]") Endif Endif Gosub Defmouse(0) Outlog("Appel: "+Callcnx$+" "+Pavi$) ' Gosub Tar0 ! tarif pallier 0 actuel Return ' ' Tarificateur Procedure Tar0 Local A$,B$ Local N& Local A! ' Redcnx%=100 Pal0cnx&=-1 Pal1cnx&=-1 Clr Red0cnx!,Red1cnx! Accpal!=False If Len(Callcnx$)>0 ' A$=@Finput$("TARIFS.SET") A$=Tarif$ While Len(A$)>0 B$=Upper$(Trim$(@Flin$(A$))) Gosub Reduction(B$) ! est-ce une r‚duc? N&=Instr(B$," ") If N&>0 A!=False ! non reconnu If Mid$(B$,N&-1,1)="*" ! num‚ro jocker If Left$(B$,N&-2)=Left$(Callcnx$,N&-2) ! num‚ro reconnu! A!=True Endif Else if Left$(B$,N&-1)=Callcnx$ ! num‚ro reconnu! A!=True Endif If A! ! num‚ro reconnu! If Right$(@Xtrim$(@Ntrim$(Mid$(B$,N&+1))))="+" ! r‚ducs! Red0cnx!=True Endif Pal0cnx&=Val(@Xtrim$(@Ntrim$(Mid$(B$,N&+1)))) ! pallier z‚ro (t‚l‚tel) ' '''Pal1cnx&=0 XXXXXXX ! pallier un (services) Pal1cnx&=-1 ! pallier 1 inhib‚ pour l'instant Clr Red1cnx! Clr Pal1$ ' Clr A$ ! exit ' Else Clr N& Endif Endif Wend Endif Return ' ' Couper et filtrer le fichier! Procedure Facinit Local A& Local A$,E$ ' If Len(Facture$)>0 E$=Facture$ Clr Facture$ A&=Rinstr(E$,"----------") ! d‚but du mois If A&>0 E$=Mid$(E$,A&) A$=@Flin$(E$) ! vider la ligne Endif ' While Len(E$)>0 A$=Trim$(@Flin$(E$)) Facture$=Facture$+A$+"|" Wend ' Gosub Outcom("") ! v‚rifier taille (pas trop gros?) et datation Else If Logt&>0 A$="Date Heure Appel Dur‚e Co–t"+Mki$(&HD0A) A$=A$+String$(78,"-")+Mki$(&HD0A) ~@Fwrite(Logt&,A$) Endif Endif ' Return Procedure Set_tar Local A&,B&,N&,P&,X&,Y&,Z&,S& Local A$,B$,E$ Local X2&,Y2&,T& ' E$=Facture$ X&=Com_1&+7 Y&=Com_2&+7 Z&=Com_3&+7 Char{Ob_spec(Adr%(40),Com_2b&)}=@Tar_sum2$ ! facture actuelle Char{Ob_spec(Adr%(40),Com_3b&)}=Str$(@Tar_sum) ! facture actuelle ' Clr N&,P& P&=Instr(E$,"|",P&+1) While P&>0 P&=Instr(E$,"|",P&+1) Inc N& Wend S&=N& N&=Max(0,S&-7) ' Exdo!=True A&=Byte(@Form_wdo(40,-2)) Do Clr P& If N&>0 For A&=0 To N&-1 P&=Instr(E$,"|",P&+1) Next A& Endif For A&=0 To 7 Char{Ob_spec(Adr%(40),Com_1&+A&)}="" Char{Ob_spec(Adr%(40),Com_2&+A&)}="" Char{Ob_spec(Adr%(40),Com_3&+A&)}="" Next A& For A&=0 To 7 R&=P& P&=Instr(E$,"|",P&+1) Exit if P&<=0 A$=Mid$(E$,R&+1,P&-R&-1) B$=@Lft$(A$) ! prix Char{Ob_spec(Adr%(40),Com_3&+A&)}=Left$(B$,6) B$=@Lft$(A$) ! dur‚e Char{Ob_spec(Adr%(40),Com_2&+A&)}=Left$(B$,8) Char{Ob_spec(Adr%(40),Com_1&+A&)}=Left$(A$,32) Next A& ' Ob_y(Adr%(40),Com_sl&)=((Ob_h(Adr%(40),Com_bs&)-Ob_h(Adr%(40),Com_sl&))*N&)\Max(1,(S&-8)) ~Objc_draw(Adr%(40),Com_bs&,7,Rx&(40),Ry&(40),Rw&(40),Rh&(40)) ' ~Objc_draw(Adr%(40),Com_b1&,7,Rx&(40),Ry&(40),Rw&(40),Rh&(40)) ~Objc_draw(Adr%(40),Com_b2&,7,Rx&(40),Ry&(40),Rw&(40),Rh&(40)) ~Objc_draw(Adr%(40),Com_b3&,7,Rx&(40),Ry&(40),Rw&(40),Rh&(40)) A&=Byte(@Form_wdo(40,0)) Ob_state(Adr%(40),A&)=Bclr(Ob_state(Adr%(40),A&),0) Select A& Case Com_sl& X2&=Graf_slidebox(Adr%(40),Com_bs&,Com_sl&,1) ! g‚rer slide N&=(Max(1,S&-8)*X2&)\1000 N&=Max(0,Min(S&-8,N&)) ' ~Objc_draw(Adr%(40),Com_bs&,255,Rx&(40),Ry&(40),Rw&(40),Rh&(40)) @Waitmouse ' Case Com_bs& Mouse X2&,Y2&,T& ~Objc_offset(Adr%(40),Com_sl&,X2&,T&) If Y2&0 N&=N&+1 Endif Case Com_1& To X& ' ~@Form_wdo(40,-3) ' Gosub W_rdexe ' A$=@Dinput$("D‚signation",Char{Ob_spec(Adr%(40),A&)},B&) ' If B& ' Endif ' Exdo!=True Case Com_3& To Z& ' ~@Form_wdo(40,-3) ' Gosub W_rdexe ' A$=@Dinput$("Co–t",Char{Ob_spec(Adr%(40),A&)},B&) ' If B& ' Endif ' Exdo!=True Default Exit if True Endselect Loop ~@Form_wdo(40,-3) ' Return Function Lft$(Var E$) Local A& Local A$ E$=Trim$(E$) A&=Rinstr(E$," ") If A&>0 A$=Trim$(Mid$(E$,A&+1)) E$=Trim$(Left$(E$,A&-1)) Else A$=Trim$(E$) Clr E$ Endif Return A$ Endfunc ' ' ' traite chaine CSI e$, -1 si trait‚ Function T_csi(Flag!,E$) $F% Local A&,B&,N& Local W&,H& ' Select Right$(E$,1) ' \/&\/ euh.. Case "@" To "Z","a" To "z","{","~","{","|" ' on saute+‚value les params ex: Csi 12;34;5;6;7;8XXX ' Arrayfill Csip&(),0 Arrayfill Csix!(),False ' Clr N& A&=0 Repeat B&=1 While @Csi_n(Asc(Mid$(E$,A&+B&,1))) Inc B& Wend If B&<>1 If N&<=31 ! sinon tant pis!!.. If (B&-1)<=10 ! pas trop grand! (2^32 max!) Csip&(N&)=Val(Mid$(E$,A&+1,B&-1)) Else Csip&(N&)=0 Endif Csix!(N&)=True Endif Endif Inc N& Add A&,B& Until Mid$(E$,A&,1)<>";" Or A&>Len(E$) ' print "Nb:";N&,"1=";Csip(0),"2=";Csip(01),"Pos=";A& N&=Min(31,N&) ' $S% Select Mid$(E$,A&,4) Case "@" If Emulm|=3 Def_csi(1,False) ! valeur par d‚faut ' Csip&(0)=Max(Csip&(0),1) Csip&(0)=Min(Csip&(0),Vmax_x&-X_curs&+1) Gosub Inschar(X_curs&,Y_curs&,Csip&(0),Flag!) Endif ' Case "A" ! Csi A hAut Def_csi(1,False) ! valeur par d‚faut ' If Not Vtransp! If Y_curs&>0 ! Non line0 Csip&(0)=Max(Csip&(0),1) Sub Y_curs&,Csip&(0) If Y_curs&<1 Y_curs&=1 Endif Vdt_setme Endif Endif Case "B" ! Csi B Bas Def_csi(1,False) ! valeur par d‚faut ' If Not Vtransp! If Y_curs&>0 ! Non line0 Csip&(0)=Max(Csip&(0),1) Add Y_curs&,Csip&(0) If Y_curs&>Vmax_y& Y_curs&=Vmax_y& Endif Vdt_setme Endif Endif Case "C" ! Csi C droite Def_csi(1,False) ! valeur par d‚faut ' If Not Vtransp! If Y_curs&>0 ! Non line0 Csip&(0)=Max(Csip&(0),1) Add X_curs&,Csip&(0) If X_curs&>Vmax_x& X_curs&=Vmax_x& Endif Vdt_setme Endif Endif Case "D" ! Csi D gauche Def_csi(1,False) ! valeur par d‚faut ' If Not Vtransp! If Y_curs&>0 ! Non line0 Csip&(0)=Max(Csip&(0),1) Sub X_curs&,Csip&(0) If X_curs&<0 X_curs&=0 Endif Vdt_setme Endif Endif ' Case "H","f" ! pos (f=idem!) Def_csi(1,1) ! valeur par d‚faut ' If Y_curs&>0 ! Non line0 Swap Csip&(0),Csip&(1) ! invers‚s Csip&(0)=Max(0,Csip&(0)-1) Csip&(0)=Min(Csip&(0),Vmax_x&) Csip&(1)=Max(1,Csip&(1)) Csip&(1)=Min(Csip&(1),Vmax_y&) X_curs&=Csip&(0) Y_curs&=Csip&(1) Vdt_setme Endif ' Case "J" ! J effacement zone Def_csi(0,False) ! valeur par d‚faut ' $S& Select Csip&(0) Case 0 ! eff curseur->fin ‚cran For H&=Y_curs& To Vmax_y& If H&=Y_curs& Csip&(1)=X_curs& Else Csip&(1)=0 Endif For W&=Csip&(1) To Vmax_x& Vids&(W&,H&)=32 Vida|(W&,H&)=&X1000000 ! Inhibiteur pour fond XXXX Vidc&(W&,H&)=&H700 If Flag! Gosub Vdraw(W&,H&) Else Vidrd|(W&,H&)=&HFF ! redraw quand mˆme ? Endif Next W& Next H& Case 1 ! eff d‚but->curseur For H&=0 To Y_curs& If H&=Y_curs& Csip&(1)=X_curs& Else Csip&(1)=Vmax_x& Endif For W&=0 To Csip&(1) Vids&(W&,H&)=32 Vida|(W&,H&)=&X1000000 ! Inhibiteur pour fond XXXX Vidc&(W&,H&)=&H700 If Flag! Gosub Vdraw(W&,H&) Else Vidrd|(W&,H&)=&HFF ! redraw quand mˆme ? Endif Next W& Next H& Case 2 ! eff tout Em_x&=X_curs& Em_y&=Y_curs& Gosub Vcls(Flag!) X_curs&=Em_x& Y_curs&=Em_y& Endselect $S% ' Case "K" ! K effacement Def_csi(0,False) ! valeur par d‚faut ' $S& Select Csip&(0) Case 0 ! curs->fin For W&=X_curs& To Vmax_x& Vids&(W&,Y_curs&)=32 Vida|(W&,Y_curs&)=&X1000000 ! Inhibiteur pour fond XXXX Vidc&(W&,Y_curs&)=&H700 If Flag! Gosub Vdraw(W&,Y_curs&) Else Vidrd|(W&,Y_curs&)=&HFF ! redraw quand mˆme ? Endif Next W& Case 1 ! d‚b->curs For W&=0 To X_curs& Vids&(W&,Y_curs&)=32 Vida|(W&,Y_curs&)=&X1000000 ! Inhibiteur pour fond XXXX Vidc&(W&,Y_curs&)=&H700 If Flag! Gosub Vdraw(W&,Y_curs&) Else Vidrd|(W&,Y_curs&)=&HFF ! redraw quand mˆme ? Endif Next W& Case 2 ! eff ligne For W&=0 To Vmax_x& Vids&(W&,Y_curs&)=32 Vida|(W&,Y_curs&)=&X1000000 ! Inhibiteur pour fond XXXX Vidc&(W&,Y_curs&)=&H700 If Flag! Gosub Vdraw(W&,Y_curs&) Else Vidrd|(W&,Y_curs&)=&HFF ! redraw quand mˆme ? Endif Next W& Endselect $S% ' Case "M" ! M, delete line at current position Def_csi(1,False) ! valeur par d‚faut ' If Y_curs&<>0 ! CSI interdit sinon (ignor‚s) Csip&(0)=Max(Csip&(0),1) Csip&(0)=Min(Csip&(0),Vmax_y&-Y_curs&+1) Gosub Delline(X_curs&,Y_curs&,Csip&(0),Flag!) X_curs&=0 Endif Case "L" ! L, insert one line at curent position Def_csi(1,False) ! valeur par d‚faut ' If Y_curs&<>0 Csip&(0)=Max(Csip&(0),1) Csip&(0)=Min(Csip&(0),Vmax_y&-Y_curs&+1) Gosub Insline(X_curs&,Y_curs&,Csip&(0),Flag!) X_curs&=0 Endif Case "P" ! P delete character at current XY position Def_csi(1,False) ! valeur par d‚faut ' If Y_curs&<>0 Csip&(0)=Max(Csip&(0),1) Csip&(0)=Min(Csip&(0),Vmax_x&-X_curs&+1) Gosub Delchar(X_curs&,Y_curs&,Csip&(0),Flag!) Endif ' Case "R" ! r‚ponse, rien … faire ' Case "T" ! 1 haut If Emulm|=3 If Y_curs&>0 ! Non line0 Csip&(0)=Max(Csip&(0),1) Dec Y_curs& If Y_curs&<1 Y_curs&=1 Endif Vdt_setme Endif Endif ' Case "S" ! 1 bas If Emulm|=3 If Y_curs&>0 ! Non line0 Csip&(0)=Max(Csip&(0),1) Inc Y_curs& If Y_curs&>Vmax_y& Y_curs&=Vmax_y& Endif Vdt_setme Endif Endif ' Case &H3F7A @Emtechinfo("80 colonnes ->") Gosub Rep_ini80 Gosub Emulm(1) ! 80 col Em_d!=-1 ! redraw Case &H3F7B @Emtechinfo("40 colonnes ->") If @Answer Fsend(Chr$(19)+"^") ! ‚tat standard 40 col Endif Gosub Emulm(0) ! 40 col Em_d!=-1 ! redraw ' Case "c" ! reset init state Def_csi(0,False) ! valeur par d‚faut ' If Csip&(0)=0 ! CSI 0c If @Answer ' r‚ponse demande curseur Fsend(Chr$(27)+"[?l;0c") Endif ' Endif ' Case "g" ! tab clr ' Case "h" ! h insert If Y_curs&<>0 If Csip&(0)=52 Vmode!=True Endif Endif Case "l" ! l replace If Y_curs&<>0 If Csip&(0)=52 Vmode!=False Endif Endif ' Case "m" ! select attrb&colors Def_csi(0,False) ! valeur par d‚faut ' If Emulm|<>0 ' ' Exemple: Csi 0;1;4;33m For W&=0 To N&-1 If Csix!(W&) Or W&=0 Select Csip&(W&) Case 0 Clr Acurs| Case 1 Acurs|=Bset(Acurs|,2) ! light "surintensit‚" Case 2 ! (CONNECT) Lighted Acurs|=Bset(Acurs|,6) Case 3 ! (CONNECT) Skweed Acurs|=Bset(Acurs|,7) Case 4 Acurs|=Bset(Acurs|,1) ! soulign‚ "soulign‚" Case 5 Acurs|=Bset(Acurs|,0) ! clignotant "clignotant" Case 7 Acurs|=Bset(Acurs|,3) ! invers‚ "invers‚ fond, n‚gatif" Case 9 Acurs|=Bset(Acurs|,4) ! altern‚ Case 13 Acurs|=Bset(Acurs|,9) ! alt '' Case 22 Acurs|=Bclr(Acurs|,2) ! "surintensit‚ normale" Case 24 Acurs|=Bclr(Acurs|,1) ! souligne off Case 25 Acurs|=Bclr(Acurs|,0) ! clignote off Case 27 Acurs|=Bclr(Acurs|,3) ! inverse off ' ' Couleurs ANSI: (toujours texte, il existe seulement l'invers‚!) Case 30 To 37 Ccurs&=And(Ccurs&,&HFF) Ccurs&=Or(Ccurs&,Intercol&(Csip&(W&)-30)*&H100) Case 40 To 47 Ccurs&=And(Ccurs&,&HFF00) Ccurs&=Or(Ccurs&,Intercol&(Csip&(W&)-40)) ' Endselect Endif Next W& Endif ' Case "n" ! pos curseur? (M2) Def_csi(0,False) ! valeur par d‚faut ' If Csip&(0)=6 ! CSI 6n If @Answer ' r‚ponse demande curseur Fsend(Chr$(27)+"["+Str$(Y_curs&)+";"+Str$(X_curs&+1)+"R") Endif ' Endif ' Case "s" Cs_x&=X_curs& Cs_y&=Y_curs& ' Case "u" X_curs&=Cs_x& Y_curs&=Cs_y& Vdt_setme ' Case "X" ! DELIRE perso!!!! Csi_hi(Flag!) ' Case "Z" ! Tab inverse If Emulm|=3 X_curs&=((X_curs&-1)\8)*8 ! InvTab X_curs&=Max(0,X_curs&) Vdt_setme Endif ' Default ! avort‚ ' Return True Endselect ' 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 ' Valeurs par d‚faut Procedure Def_csi(X&,Y&) If Not Csix!(0) Csip&(0)=X& Endif If Not Csix!(1) Csip&(1)=Y& Endif Return Procedure Csi_hi(Flag!) If Csip&(0)=3 And Csip&(1)=1 And Csip&(2)=4 @Vprint(Chr$(14)+Chr$(15)+" Swiftel Photo III ½R.X. 1996-1997, All rights reserved") ' Else if Csip&(0)=2 And Csip&(1)=7 And Csip&(2)=1 If Len(Register$)>0 Fsend(Chr$(1)+"SWIFTEL"+Release$+"R"+Chr$(4)) Else Fsend(Chr$(1)+"SWIFTEL"+Release$+"U"+Chr$(4)) Endif Endif ' Return ' Affichage de ligne d'info texte Procedure Vprint(A$) Local C&,A& ' Drcurs(False) X_curs&=0 Inc Y_curs& If Y_curs&>Vmax_y& Y_curs&=@Ynewcurs(1,Em_fl!) If Emulm|=0 ! non ansi If Not Btst(Acurs|,4) ! si texte! Ccurs&=And(Ccurs&,&HFF00) Endif Endif Endif ' For A&=1 To Len(A$) C&=Asc(Mid$(A$,A&,1)) Echar(X_curs&,Y_curs&,C&,Flag!) Next A& ' Return ' Procedure Sep_clav(C&) $S& Select C& Case "A","B","C","D","F","H" ! envoi,retour,r‚p‚t,guide,somm,suite ' ' Copie de vcls d‚but If Magneto&=1 If Mwait! Okwait!=True ! pr‚venir l'envoyeur pour noter, et nous aussi! Oktype|=1 Endif Endif ' Endselect Return ' ' ' Procedure Rep_aig(A&) ! R‚ponses aiguillages ' print "aiguillage" ' ' r‚ponses pr‚d‚finies... mais c'est mieux que rien! If @Answer $S& Select A& Case "X" ! X ‚cran Fsend(Pro3$+"c"+Chr$(A&)+"M") Case "Y" ! Y clavier Fsend(Pro3$+"c"+Chr$(A&)+"B") Case "Z" ! Z modem Fsend(Pro3$+"c"+Chr$(A&)+"F") Case "[" ! [ prise Fsend(Pro3$+"c"+Chr$(A&)+"J") Case "P" ! p ‚cran Fsend(Pro3$+"c"+Chr$(A&)+"A") Case "Q" ! Q clavier Fsend(Pro3$+"c"+Chr$(A&)+"N") Case "R" ! R modem Fsend(Pro3$+"c"+Chr$(A&)+"E") Case "S" ! S prise Fsend(Pro3$+"c"+Chr$(A&)+"I") Endselect $S% Endif Return Procedure Rep_fonct ! r‚ponse status fonctionnement ' print "fonct" If @Answer Em_z&=&X1000000 ! Bit #6 If Rmode! ! Rouleau Em_z&=Bset(Em_z&,1) Endif If Emulm|<>0 ! 80 colonnes Em_z&=Bset(Em_z&,0) Endif If Not Btst(Bios(11,-1),4) ! min Em_z&=Bset(Em_z&,3) Endif ' ' Em_z&=Bset(Em_z&,2) ! PCE.. NAANN!! c'est la merde … g‚rer.. et c'est inutile (DPE/PAE) Fsend(Pro2$+"s"+Chr$(Em_z&)) Endif Return Procedure Rep_term ! r‚ponse status terminal ' print "terminal" If @Answer ' @write5(Pro2$+"q"+Chr$(&X1011110); ! conect‚ Fsend(Pro2$+"q"+Chr$(&X1011011)) ! connect‚ Endif Return Procedure Rep_vit ! r‚ponse status vitesse ' print "vitesse" If @Answer Fsend(Pro2$+"d"+Chr$(100)) Endif Return Procedure Rep_protoc ! r‚ponse status protocole Local N& ' print "proto" If @Answer N&=&X1000011 If Padx3! ! comp. PAD-X3 N&=Bset(N&,4) Endif Fsend(Pro2$+"w"+Chr$(N&)) Endif Return Procedure Rep_id ! r‚ponse identification ' print " ident Bv9" If @Answer Select Ansid| Case 0 ! pas de r‚ponse Case 1 Fsend(Chr$(1)+"Cc9"+Chr$(4)) ! Id. Minitel 1 Case 2 Fsend(Chr$(1)+"Bu9"+Chr$(4)) ! Id. Minitel 1b Case 3 Fsend(Chr$(1)+"Bv9"+Chr$(4)) ! Id. Minitel 2 Case 4 Fsend(Chr$(1)+"Pv4"+Chr$(4)) ! Id. Minitel photo Endselect Endif Return Procedure Rep_ini40 ! remise … ‚tat initial (40 col) ' print "ini40" If @Answer ' @write5(Chr$(19)+"^"; ! remise … l'‚tat initial Fsend(Sep$+"q") Endif Return Procedure Rep_ini80 ! mise … l'‚tat 80 colonnes If @Answer ' @write5(Chr$(27)+"[?z"; ! renvoi 80 col! Fsend(Sep$+"p") Endif Return Procedure Rep_clav ! r‚ponse status clavier ' print "clav" If @Answer Fsend(Pro3$+"sY"+Chr$(64)) Endif Return Procedure Rep_gal ! R‚ponse g‚n‚ral status If @Answer ' Profil... (!) Fsend(Mki$(&H1F20)+Mkl$(&H44617E7E)+Mkl$(&H55314131)+Mkl$(&H42523245)+Mkl$(33443345)+Chr$(&H40)) Endif Return Procedure Rep_reset ! r‚ponse aprŠs RESET vid‚otex Fsend(Chr$(19)+"^") ! remise … l'‚tat initial Rep_aig(Asc("Z")) Rep_aig(Asc("[")) 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& ' ' print "KEEP ";Flag! ' print Btst(Acurs|,4) ' If Emulm|<>3 ! vid‚otex 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| ' ' ->22 ' ' XXXXXXXXXXX oui ok perdre status!! Dmodet!=False Dmodeg!=False Acurs|=Bclr(Acurs|,7) ' ' (ne pas faire ici!) ' Clr_spe ! init, en cas de s‚quence de chargement!! ' Clr Special& Else ' eh oui, on peut interrompre un chargement drcs!! (ou photo) Vsavet&(13)=Photo! For A&=0 To 5 Vsavet&(A&+23)=Spe|(A&) Next A& For A&=0 To 13 Vsavet&(A&+29)=Spedr|(A&) Next A& Vsavet&(43)=Special& Endif Endif ' Return Procedure Restore_a0 Local A& ' If Emulm|<>3 ! vid‚otex 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) Photo!=Vsavet&(13) For A&=0 To 5 Spe|(A&)=Vsavet&(A&+23) Next A& For A&=0 To 13 Spedr|(A&)=Vsavet&(A&+29) Next A& Special&=Vsavet&(43) ' Endif ' Return Procedure Clr_a0 ' Local A& ' Arrayfill Vsavet&(),0 ' For A&=0 To 43 ' 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!,B! ' If Emulm|=0 ! vid‚otex If Btst(Acurs|,4) ! graph B!=Btst(Acurs|,1) Acurs|=Bclr(Acurs|,1) ! ne pas propager mosaique Else B!=False Endif 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+2) ! <>lettre haute (partie haute) A!=True ! ne pas souligner comme un bourrin! Endif Else Vida|(X&,Y&)=Bclr(Vida|(X&,Y&),1) Endif Endif ' ' ' a chang‚? ou restore line off? If (Vidc&(X&,Y&)<>T&) Or (T! And (Not Btst(Acurs|,1))) 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 Else Vidrd|(X&,Y&)=&HFF ! redraw quand mˆme ? Endif Endif ' Inc X& Wend If Btst(Acurs|,1) ! on a dessin‚ une ligne!! WARNING! propager … X+1 Gosub Prol Endif If B! Acurs|=Bset(Acurs|,1) Endif If Btst(Anext_t|,1) If Btst(Anext|,1) Acurs|=Bclr(Acurs|,1) Endif Endif Endif ' Return Procedure Prol Local A&,B& ' ' sous routine de @propage - prolonge la ligne!! ' Warning! propager … X+1 car le d‚part soulignement est … n+1 ' If X&-X_curs&=>2 ! c…d X-X_curs&-1=>1 !! A&=@Wxacoord(4,Eccsizex&*X_curs&+Emx&) B&=@Wyacoord(4,Eccsizey&*Y_curs&+Emy&) Vf_x&=X_curs& Vf_x&=Y_curs& @Vfond ! pour le test-invisible @Vtext If Not A! Line A&+Eccsizex&,B&+Eccsizey&-1,A&+Eccsizex&*(X&-X_curs&)-1,B&+Eccsizey&-1 Else ' For T&=0 To X&-X_curs&-1 For T&=1 To X&-X_curs&-1 If Not Btst(Vids&(X_curs&+T&,Y_curs&),8+2) ! <>lettre haute (partie haute) If Flag! Line A&+T&*Eccsizex&,B&+Eccsizey&-1,A&+Eccsizex&*(T&+1)-1,B&+Eccsizey&-1 Else Vidrd|(X_curs&+T&,Y_curs&)=&HFF ! redraw quand mˆme ? Endif Endif Next T& Endif Endif ' Return ' ' ' Protection finale: BOUM! Function Check3 Local A&,N& Local A$,B$,C$,E$,F$ Local A# ' ' Bidon N&=X_curs& E$=Title$ F$=Release$ C$=E$+F$+E$ A#=X_curs& A#=A#*0.126 ' ' T'es mort! If @Crc83(Key$(2))+(Len(Key$(2))=0)<>@Repak3(Mid$(Key$(3),7,2)) ' 1ø V‚roler le programme Fileh&=@Fopen(Nom_prg$+Chr$(0),2) Set_end!=True ~@Fadrwrite(Fileh&,V:Nom_prg$,256) ~@Fclose(Fileh&) ' ' 2ø Faire peur avec des fichiers rigolos For A&=&H101 To &H120 Fileh&=@Fcreate(Set_path$+Mki$(A&)+Mki$(A&)+".PRG",&X1) ~@Fclose(Fileh&) Next A& Endif ' E$=A$+F$+C$ A#=X_curs& A#=Y_curs&+X_curs& ' Return True Endfunc ' ' ' Bourrage ligne 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) And (Not Btst(Acurs|,4)) ! lignage? (et pas graph) 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)) Sw_clip Pbox A%,B%+Btst(Tcurs|,1)*Eccsizey&,A%+Eccsizex&*(Vmax_x&-X_curs&+1)-1,B%+Eccsizey&-1 If A! ! lignage @Vfond ! pour le test-invisible 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 ' ' ' Insertion/remplacement ligne ' F=-1 redraw 0=no redraw 1=simple d‚calage physique Procedure Delline(X&,Y&,N&,F&) ' Local A&,B&,A%,B%,X%,Y%,W%,H% Local A&,A%,B% ' X&=0 If Y&>0 N&=Min(N&,Vmax_y&-Y&) If N&>0 ! on peut d‚truire? ' ' STS, Faster than the light!!!!!! ' Line*W*Nombre If F&<>1 If N&0 ! 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 ' If F&<>1 ' More faster!!!!!!!!!!!!!!!! (!) For A&=Vmax_y&-N&+1 To Vmax_y& Bmove V:Vclrs&(0),V:Vids&(0,A&),100*2 ! copier ligne vide If Emulm|=0 Bmove V:Vclrc&(0,0),V:Vidc&(0,A&),100*2 ! copier ligne vide Else Bmove V:Vclrc&(0,Byte(Ccurs&)),V:Vidc&(0,A&),100*2 ! copier ligne couleur Endif Bmove V:Vclra|(0),V:Vida|(0,A&),100 ! copier ligne vide Bmove V:Vclrrd|(0),V:Vidrd|(0,A&),100 ! copier ligne vide Next A& Endif ' ' For B&=Vmax_y&-N&+1 To Vmax_y& ' For A&=0 To Vmax_x& ' Vids&(A&,B&)=32 ' Vidc&(A&,B&)=&H700 ' Vida|(A&,B&)=&X1000000 ! Inhibiteur pour fond XXXX ' Next A& ' Next B& ' If F&<>0 @Lhidem Bndary(0) A%=@Wxacoord(4,Emx&) B%=@Wyacoord(4,(Vmax_y&-N&+1)*Eccsizey&+Emy&) If Emulm|<>3 ! vid‚otex Gosub Deffill(Fcol&(0),Fstyl|(0),Findex|(0)) ! Stndrd Else A&=Intercol&(Byte(Ccurs&)) Gosub Deffill(Fcol&(A&),Fstyl|(A&),Findex|(A&)) ! col Endif ' Deffill 3 ! test ' ou Vfond(X&,Y&) ! Fond sp‚cial.. Pbox A%,B%,A%+Eccsizex&*(Vmax_x&+1)-1,B%+Eccsizey&*N&-1 ! Box standard! Bndary(1) @Lshowm Else If Not Viddec! ! pas annul‚ If Y&=1 ! d‚calage standard de page Sub Vidrdl&,N& ! delete Else Vidrdall!=True ! redraw all (cls) flag Viddec!=True ! d‚coupage csi multiple, tout redessiner!! Clr Vidrdl& Endif Else Vidrdall!=True ! redraw all (cls) flag Clr Vidrdl& Endif Endif ' Endif ' Return Procedure Insline(X&,Y&,N&,F&) ' Local A&,B&,A%,B%,X%,Y%,W%,H% Local A&,A%,B% ' ' Note: Y=1 premiŠre ligne X&=0 If Y&>0 N&=Min(N&,Vmax_y&-Y&) If N&>0 ! on peut d‚truire? ' ' If F&<>1 If N&0 ! 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 ' If F&<>1 ' More faster!!!!!!!!!!!!!!!! (!) For A&=Y& To Y&+N&-1 Bmove V:Vclrs&(0),V:Vids&(0,A&),100*2 ! copier ligne vide If Emulm|=0 Bmove V:Vclrc&(0,0),V:Vidc&(0,A&),100*2 ! copier ligne vide Else Bmove V:Vclrc&(0,Byte(Ccurs&)),V:Vidc&(0,A&),100*2 ! copier ligne couleur Endif Bmove V:Vclra|(0),V:Vida|(0,A&),100 ! copier ligne vide Bmove V:Vclrrd|(0),V:Vidrd|(0,A&),100 ! copier ligne vide Next A& 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 ' Next A& ' Next B& ' If F&<>0 @Lhidem Bndary(0) A%=@Wxacoord(4,Emx&) B%=@Wyacoord(4,Y&*Eccsizey&+Emy&) If Emulm|<>3 Gosub Deffill(Fcol&(0),Fstyl|(0),Findex|(0)) ! Stndrd Else A&=Intercol&(Byte(Ccurs&)) Gosub Deffill(Fcol&(A&),Fstyl|(A&),Findex|(A&)) ! col Endif ' Deffill 2 !test ' ou Vfond(X&,Y&) ! Fond sp‚cial.. Pbox A%,B%,A%+Eccsizex&*(Vmax_x&+1)-1,B%+Eccsizey&*N&-1 ! Box standard! Bndary(1) @Lshowm Else ' If Not Viddec! If Y&=1 ! d‚calage standard de page Add Vidrdl&,N& ! insert Else Vidrdall!=True ! redraw all (cls) flag Viddec!=True ! d‚coupage csi multiple, tout redessiner!! Clr Vidrdl& Endif Else Vidrdall!=True ! redraw all (cls) flag Clr Vidrdl& Endif 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 If X&X& Vids&(A&+N&,Y&)=Vids&(A&,Y&) Vidc&(A&+N&,Y&)=Vidc&(A&,Y&) Vida|(A&+N&,Y&)=Vida|(A&,Y&) Dec A& Wend Endif For A&=X& To Min(X&+N&-1,Vmax_x&) Vids&(A&,Y&)=32 If Emulm|=0 Vidc&(A&,Y&)=&H700 Else Vidc&(A&,Y&)=Byte(Ccurs&) Endif ' Vidc&(A&,Y&)=C& Vida|(A&,Y&)=&X1000000 Next A& If Flag! If X&+N&-10 If Y%+H%<=Work_out(1)+1 @Lhidem Scr_copy(X%,Y%,W%,H%,X2%,Y2%) @Lshowm Else Rdw_all(4) Endif Else Rdw_all(4) Endif Else Rdw_all(4) Endif Else Rdw_all(4) Endif ' Return ' ' ' Procedure de dessin en ligne (un TEXT g‚n‚ral est 10 fois plus rapide que des TEXT) Procedure Linedraw(A!,X&,Y&,L&) ' L&=Min(L&,Vmax_x&+1-X&) Do Ld_c&=Vidc&(X&,Y&) Ld_a|=Vida|(X&,Y&) Ld_a&=X& If @Ldtst ! OK Inc Ld_a& While @Ldtst Inc Ld_a& Wend ' If Emulm|=0 ' If And(Vids&(X&,Y&),&HFF00)<>0 ! car taille <> ' Ld_a&=X&+1 ! traiter … part! ' Endif ' Endif Else Ld_a&=X&+1 ! traiter … part! Endif ' While Vidc&(Ld_a&,Y&)=Ld_c& And @Ldtst And Ld_a&4 And (Not Set_drfnt!) ! ca vaut le coup! dessin auto ' Ld_a!=True ! on effectue rien … priori For Jus_a&=0 To Min(128,Ld_a&-X&-1) ' Intin(Jus_a&+2)=Vids&(X&+Jus_a&,Y&) ' ' If Ld_a! If Vidp|(X&+Jus_a&,Y&)=0 ! pas photo If Byte(Vids&(X&+Jus_a&,Y&))=32 ! spc If Byte(Vidc&(X&+Jus_a&,Y&))=0 ! fond 0 If And(Vida|(X&+Jus_a&,Y&),&X1010)=0 ! ni line ni inv ' If Y&=0 And X&+Jus_a&=F_c& ! "F" ' Ld_a!=False ' Endif Else Ld_a!=False Exit if True Endif Else Ld_a!=False Exit if True Endif Else Ld_a!=False Exit if True Endif Else Ld_a!=False Exit if True Endif ' Endif ' Next Jus_a& ' Vd_a&=Eccsizex&*X&+Emx&-Start_x%(4)+W_ix&(4) Vd_b&=Eccsizey&*Y&+Emy&-Start_y%(4)+W_iy&(4) ' Graphmode 1 Vf_x&=X& Vf_y&=Y& Gosub Vfond Pbox Vd_a&,Vd_b&,Vd_a&+Eccsizex&*(Ld_a&-X&)-1,Vd_b&+Eccsizey&-1 Graphmode 2 ' If Not Ld_a! Vf_x&=X& Vf_y&=Y& Gosub Vtext ' If Set_text&<>0 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&=0 Contrl(0)=12 ! Set character height, Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=Etext&(0) Vdisys Endif ' ' ' Copie de Justext Contrl(0)=11 ! GDP Contrl(1)=2 Contrl(3)=(Ld_a&-X&)+2 ! Ld_a&-X&=Nbr car Contrl(5)=10 ! justified Contrl(6)=V~h Ptsin(0)=Vd_a& Ptsin(1)=Vd_b&+Decalt&(0) ! TOUJOURS pour du texte normal ' Ex: 3 lettres, Eccsizex=6, Textx=4 -> 6*3=18 pts en tout ' Texte: 4*3=12 - restent 6 pts … r‚partir en...DEUX!! ' A B C ' ^ ^ ^ici ne sera pas ajout‚! ' ' -> Retirer 2 points=Eccxizex-Textx ' Ptsin(2)=Eccsizex&*(Ld_a&-X&)-(Eccsizex&-Textx&) ! largeur=taille_x*n-poteau Intin(0)=0 ! rien entre les mots Intin(1)=1 ! entre les lettres For Jus_a&=0 To Min(128,Ld_a&-X&-1) Intin(Jus_a&+2)=Byte(Vids&(X&+Jus_a&,Y&)) ! octet ** Next Jus_a& ' Vdisys ! Call VDI direct! Endif ' If Btst(Ld_a|,1) ! lignage ' On ‚crit aucun texte dim sp‚ciale ' Select And(Byte(Div(Ld_c&,&H100)),&X1100) ' Case 0,&X1000 ! en bas Line Vd_a&,Vd_b&+Eccsizey&-1,Vd_a&+Eccsizex&*(Ld_a&-X&)-1,Vd_b&+Eccsizey&-1 ' Endselect Endif ' If Y&=0 ! redessiner "F"/"C" ? If F_c&=>X& And F_c&<=Ld_a&-1 ! a ‚t‚ effac‚! Gosub Vdraw(F_c&,0) Endif Endif ' ' Else ! dessin normal For Ld_b&=X& To Ld_a&-1 If Imp(A!,Vidrd|(Ld_b&,Y&)<>0) Vdraw(Ld_b&,Y&) Endif Next Ld_b& Endif ' Sub L&,Ld_a&-X& X&=Ld_a& Loop until L&<=0 ! il n'est reste plus Graphmode 1 ' Return $P< Function Ldtst $F% ' If Ld_a&=>X&+L& Return 0 Endif If Not Imp(A!,Vidrd|(Ld_a&,Y&)<>0) ! NE PAS AFFICHER! Return 0 Endif $S& Select Emulm| Case 0 ' If And(Vids&(Ld_a&,Y&),&HFF00)=0 If And(Vida|(Ld_a&,Y&),&X10011010)=And(Ld_a|,&X10011010) If And(Ld_a|,&X10010000)=0 If Vidp|(Ld_a&,Y&)=0 If Vmap!(0,Byte(Vids&(Ld_a&,Y&))) Return 0 Endif Else Return 0 Endif Else Return 0 Endif Else Return 0 Endif Else Return 0 Endif Case 1,2 If And(Vida|(Ld_a&,Y&),&X11110)=And(Ld_a|,&X11110) If Vmap!(1,Byte(Vids&(Ld_a&,Y&))) Return 0 Endif Else Return 0 Endif Case 3 ! idem terminal! If And(Vids&(Ld_a&,Y&),&HFF00)=0 If And(Vida|(Ld_a&,Y&),&X11011110)<>And(Ld_a|,&X11011110) Return 0 Endif Else Return 0 Endif Endselect Return (Vidc&(Ld_a&,Y&)=Ld_c&) Endfunc $P> ' ' ' * * Routine g‚n‚rale de dessin d'un caractŠre vid‚otex * * Procedure Vdraw(X&,Y&) Swap X_curs&,X& Swap Y_curs&,Y& ' X_curs&=X& ' Y_curs&=Y& Vdraw00 Swap X_curs&,X& Swap Y_curs&,Y& Return $P< Procedure Vdraw00 ' ' ' Note: X& -> X_curs& ' Y& -> Y_curs& ' ' ' 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 ' ' ## = optimis‚ juste en dessous (faster than the light!) ' ' "Deftail(Vdt_tail&) ' Bndary(0) ## If Set_boundary&<>0 Contrl(0)=104 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=0 Vdisys Set_boundary&=0 Endif ' If Vcr! If Ncurs! @Vcurs0 Endif Endif ' ' Vd_a&=@Wxacoord(4,Eccsizex&*X_curs+Emx&) ' Vd_b&=@Wyacoord(4,Eccsizey&*y_curs+Emy&) ## Vd_a&=Eccsizex&*X_curs&+Emx&-Start_x%(4)+W_ix&(4) Vd_b&=Eccsizey&*Y_curs&+Emy&-Start_y%(4)+W_iy&(4) ' ' Traitement vid‚otex If Vidp|(X_curs&,Y_curs&)=0 ' ' 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_curs,y_curs),2) ! 'F'/'C' ? If Y_curs&=0 And X_curs&=F_c& ' Graphmode (1) ' Gosub Deffill(Tcol&(7,0),Fstyl|(Intercol&(7)),Findex|(Intercol&(7))) Gosub Deffill(Tcol&(7),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_curs,y_curs) If Not @Put_cache ! VD_a&/b&,X_curs,y_curs Vd_aff!=True ! Cache ' Clip(Max(vd_a%,W_ix&(4)),Max(vd_b%,W_iy&(4)),Eccsizex&,Eccsizey&) Graphmode 1 ' Gosub Vfond(X_curs,y_curs) Vf_x&=X_curs& Vf_y&=Y_curs& Gosub Vfond Pbox Vd_a&,Vd_b&,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey&-1 Graphmode 2 ' Gosub Vtext(X_curs,y_curs) Vf_x&=X_curs& Vf_y&=Y_curs& Gosub Vtext ' Clr Vd_w&,Vd_h& Vd_c&=Vids&(X_curs&,Y_curs&) If ((Not Btst(Vida|(X_curs&,Y_curs&),7)) And ((Not Set_drfnt!) Or Btst(Vida|(X_curs&,Y_curs&),4))) Or (Not Afdrc!) Or (Emulm|<>0) ' ' If True If Btst(Vida|(X_curs&,Y_curs&),4)=False Or Emulm|<>0 ' ' Emul_text(And(Byte(Div(Vd_c&,&H100)),&X11)) ## ' Vd_tmp&=And(Byte(Div(Vd_c&,&H100)),&X11) Vd_tmp&=And(Byte(Shr(Vd_c&,8)),&X11) If Set_text&<>Vd_tmp& 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&=Vd_tmp& Contrl(0)=12 ! Set character height, Contrl(1)=1 Contrl(3)=0 Contrl(6)=V~h Ptsin(0)=0 Ptsin(1)=Etext&(Vd_tmp&) Vdisys Endif ' $S& Select Vd_tmp& Case 0 ! normal Vd_sizw&=Eccsizex& Vd_sizh&=Eccsizey& Case 1 ! haut Vd_sizw&=Eccsizex& Vd_sizh&=Eccsizey&*2 Case 2 ! large Vd_sizw&=Eccsizex&*2 Vd_sizh&=Eccsizey& Case 3 ! double taille Vd_sizw&=Eccsizex&*2 Vd_sizh&=Eccsizey&*2 Endselect ' ' NB! R‚f‚rence=Bas & Gauche $S& ' Select And(Byte(Div(Vd_c&,&H100)),&X1100) Select And(Byte(Shr(Vd_c&,8)),&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& ' ' Note: Si on doit ‚crire du texte haut, clipper, car il se peut qu'on ' n'ait … redessiner qu'une partie!! If Vd_tmp&<>0 Swpart_clip(Vd_a&-Vd_w&,Vd_b&-Vd_h&,Eccsizex&,Eccsizey&) Endif $S& Select Emulm| Case 0 ! vid‚otex ' $S& Select Byte(Vd_c&) Case 32 ' Ne rien faire! Case 127 ' vd_aff!=False Pbox Vd_a&,Vd_b&,Vd_a&+Vd_sizw&-1,Vd_b&+Vd_sizh&-1 Case "{" ' Point r‚f=>bas gauche extrŠme Add Vd_b&,Eccsizey& Line Vd_a&,Vd_b&-Vd_sizh&,Vd_a&,Vd_b&-1 Sub Vd_b&,Eccsizey& Case "|" Add Vd_b&,Eccsizey& Line Vd_a&+Vd_sizw&\2,Vd_b&-Vd_sizh&,Vd_a&+Vd_sizw&\2,Vd_b&-1 Sub Vd_b&,Eccsizey& Case "}" Add Vd_b&,Eccsizey& Line Vd_a&+Vd_sizw&-1,Vd_b&-Vd_sizh&,Vd_a&+Vd_sizw&-1,Vd_b&-1 Sub Vd_b&,Eccsizey& Case "~" Add Vd_b&,Eccsizey& Line Vd_a&,Vd_b&-Vd_sizh&,Vd_a&+Vd_sizw&-1,Vd_b&-Vd_sizh& Sub Vd_b&,Eccsizey& Case "`" Add Vd_b&,Eccsizey& Line Vd_a&,Vd_b&-Vd_sizh&\2,Vd_a&+Vd_sizw&-1,Vd_b&-Vd_sizh&\2 Sub Vd_b&,Eccsizey& Case "_" Add Vd_b&,Eccsizey& Line Vd_a&,Vd_b&-1,Vd_a&+Vd_sizw&-1,Vd_b&-1 Sub Vd_b&,Eccsizey& Case "/" Add Vd_b&,Eccsizey& Line Vd_a&+Vd_sizw&-1,Vd_b&-Vd_sizh&,Vd_a&,Vd_b&-1 Sub Vd_b&,Eccsizey& Case "\" Add Vd_b&,Eccsizey& Line Vd_a&,Vd_b&-Vd_sizh&,Vd_a&+Vd_sizw&-1,Vd_b&-1 Sub Vd_b&,Eccsizey& Case "^" ! flŠche haut Add Vd_b&,Eccsizey& Line Vd_a&+Vd_sizw&\2,Vd_b&-Vd_sizh&,Vd_a&+Vd_sizw&\2,Vd_b&-1 Line Vd_a&+Vd_sizw&\2,Vd_b&-Vd_sizh&,Vd_a&+Vd_sizw&-3,Vd_b&-(2*Vd_sizh&)\3-1 Line Vd_a&+Vd_sizw&\2,Vd_b&-Vd_sizh&,Vd_a&+2,Vd_b&-(2*Vd_sizh&)\3-$ And And And And Imp f 8 …pfÌgraphmode 3 $f*€â/!â(Ý€ÿ!â/ÝÀÀ!â(è)f $fà †òËf$ †bÐì,è@ !Ë ÛfÌhalf box @ ô#è f@ …ðè6½f ô#È f 8 †$ And Mod Xor Release&;Eccsizey& Sub Vd_b&,Eccsizey& Case "ß" ! flŠche bas Add Vd_b&,Eccsizey& Line Vd_a&+Vd_sizw&\2,Vd_b&-Vd_sizh&,Vd_a&+Vd_sizw&\2,Vd_b&-1 Line Vd_a&+Vd_sizw&\2,Vd_b&,Vd_a&+Vd_sizw&-3,Vd_b&-(Vd_sizh&)\3-1 Line Vd_a&+Vd_sizw&\2,Vd_b&,Vd_a&+2,Vd_b&-(Vd_sizh&)\3-1 Sub Vd_b&,Eccsizey& Case "®" ! flŠche gauche Add Vd_b&,Eccsizey& Line Vd_a&,Vd_b&-Vd_sizh&\2,Vd_a&+Vd_sizw&-1,Vd_b&-Vd_sizh&\2 Line Vd_a&,Vd_b&-Vd_sizh&\2,Vd_a&+Vd_sizw&\2-1,Vd_b&-Vd_sizh&\2-(Vd_sizh&)\3 Line Vd_a&,Vd_b&-Vd_sizh&\2,Vd_a&+Vd_sizw&\2-1,Vd_b&-Vd_sizh&\2+(Vd_sizh&)\3 Sub Vd_b&,Eccsizey& Case "¯" ! flŠche droite Add Vd_b&,Eccsizey& Line Vd_a&,Vd_b&-Vd_sizh&\2,Vd_a&+Vd_sizw&-1,Vd_b&-Vd_sizh&\2 Line Vd_a&+Vd_sizw&-1,Vd_b&-Vd_sizh&\2,Vd_a&+Vd_sizw&\2-1,Vd_b&-Vd_sizh&\2-(Vd_sizh&)\3 Line Vd_a&+Vd_sizw&-1,Vd_b&-Vd_sizh&\2,Vd_a&+Vd_sizw&\2-$ And And And And Imp $ Xor ;-Vd_sizh&\2+(Vd_sizh&)\3 Sub Vd_b&,Eccsizey& ' Default ! Texte normal Text Vd_a&,Vd_b&-Vd_sizh&+Eccsizey&+Decalt&(And(Shr(Vd_c&,8),&X11)),Chr$(Vd_c&) Endselect $S% ' ' Endif ' Case 3 ! Terminal! Text Vd_a&,Vd_b&-Vd_sizh&+Eccsizey&+Decalt&(And(Shr(Vd_c&,8),&X11)),Chr$(Vd_c&) ' Default ' If (Not Btst(Vida|(X_curs&,Y_curs&),5)) ! caractŠre ANSI $S& Select Byte(Vd_c&) Case 32 ' vd_aff!=False ' Ne rien faire! Case 127 ! oui.. ' vd_aff!=False Sub Vd_a&,Vd_w& Sub Vd_b&,Vd_h& Pbox Vd_a&,Vd_b&,Vd_a&+Vd_sizw&-1,Vd_b&+Vd_sizh&-1 Add Vd_a&,Vd_w& Add Vd_b&,Vd_h& Case "|" Add Vd_b&,Eccsizey& Line Vd_a&+Vd_sizw&\2,Vd_b&-Vd_sizh&,Vd_a&+Vd_sizw&\2,Vd_b&-1 Sub Vd_b&,Eccsizey& Case "_" Add Vd_b&,Eccsizey& Line Vd_a&,Vd_b&-1,Vd_a&+Vd_sizw&-1,Vd_b&-1 Sub Vd_b&,Eccsizey& Case "/" Add Vd_b&,Eccsizey& Line Vd_a&+Vd_sizw&-1,Vd_b&-Vd_sizh&,Vd_a&,Vd_b&-1 Sub Vd_b&,Eccsizey& Case "\" Add Vd_b&,Eccsizey& Line Vd_a&,Vd_b&-Vd_sizh&,Vd_a&+Vd_sizw&-1,Vd_b&-1 Sub Vd_b&,Eccsizey& Default Text Vd_a&,Vd_b&-Vd_sizh&+Eccsizey&+Decalt&(And(Shr(Vd_c&,8),&X11)),Chr$(Vd_c&) Endselect $S% Else ! Fran‡ais, non ANSI $S& Select Byte(Vd_c&) Case 32 ' vd_aff!=False ' Ne rien faire! Case 127 ' vd_aff!=False Sub Vd_a&,Vd_w& Sub Vd_b&,Vd_h& Pbox Vd_a&,Vd_b&,Vd_a&+Vd_sizw&-1,Vd_b&+Vd_sizh&-1 Add Vd_a&,Vd_w& Add Vd_b&,Vd_h& Case "{" Text Vd_a&,Vd_b&-Vd_sizh&+Eccsizey&+Decalt&(And(Shr(Vd_c&,8),&X11)),"‚" Case "}" Text Vd_a&,Vd_b&-Vd_sizh&+Eccsizey&+Decalt&(And(Shr(Vd_c&,8),&X11)),"Š" Case "|" Text Vd_a&,Vd_b&-Vd_sizh&+Eccsizey&+Decalt&(And(Shr(Vd_c&,8),&X11)),"—" Case "~" Text Vd_a&,Vd_b&-Vd_sizh&+Eccsizey&+Decalt&(And(Shr(Vd_c&,8),&X11)),Chr$(34) Case "[" Text Vd_a&,Vd_b&-Vd_sizh&+Eccsizey&+Decalt&(And(Shr(Vd_c&,8),&X11)),"ø" Case "]" Text Vd_a&,Vd_b&-Vd_sizh&+Eccsizey&+Decalt&(And(Shr(Vd_c&,8),&X11)),"Ý" Case "#" Text Vd_a&,Vd_b&-Vd_sizh&+Eccsizey&+Decalt&(And(Shr(Vd_c&,8),&X11)),"œ" Case "_" Add Vd_b&,Eccsizey& Line Vd_a&,Vd_b&-1,Vd_a&+Vd_sizw&-1,Vd_b&-1 Sub Vd_b&,Eccsizey& Case "/" Add Vd_b&,Eccsizey& Line Vd_a&+Vd_sizw&-1,Vd_b&-Vd_sizh&,Vd_a&,Vd_b&-1 Sub Vd_b&,Eccsizey& Case "\" Add Vd_b&,Eccsizey& Line Vd_a&,Vd_b&-Vd_sizh&,Vd_a&+Vd_sizw&-1,Vd_b&-1 Sub Vd_b&,Eccsizey& Default Text Vd_a&,Vd_b&-Vd_sizh&+Eccsizey&+Decalt&(And(Shr(Vd_c&,8),&X11)),Chr$(Vd_c&) Endselect $S% Endif Endselect If Vd_tmp&<>0 Reclip ! reclipping Endif ' If Btst(Vida|(X_curs&,Y_curs&),1) ! lignage ' Select And(Byte(Div(Vd_c&,&H100)),&X1100) Select And(Byte(Shr(Vd_c&,8)),&X1100) Case 0,&X1000 ! en bas Line Vd_a&,Vd_b&+Eccsizey&-1,Vd_a&+Vd_sizw&-1,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_curs&,Y_curs&),1)=False ! lignage off If Btst(Vd_z&,0) Pbox Vd_a&,Vd_b&,Vd_a&+Vd_e1&-1,Vd_b&+Vd_e2&-1 Endif If Btst(Vd_z&,1) Pbox Vd_a&+Vd_e1&,Vd_b&,Vd_a&+Eccsizex&-1,Vd_b&+Vd_e2&-1 Endif If Btst(Vd_z&,2) Pbox Vd_a&,Vd_b&+Vd_e2&,Vd_a&+Vd_e1&-1,Vd_b&+2*Vd_e2&-1 Endif If Btst(Vd_z&,3) Pbox Vd_a&+Vd_e1&,Vd_b&+Vd_e2&,Vd_a&+Eccsizex&-1,Vd_b&+2*Vd_e2&-1 Endif If Btst(Vd_z&,4) Pbox Vd_a&,Vd_b&+2*Vd_e2&,Vd_a&+Vd_e1&-1,Vd_b&+Eccsizey&-1 Endif If Btst(Vd_z&,5) Pbox Vd_a&+Vd_e1&,Vd_b&+2*Vd_e2&,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey&-1 Endif Else If Btst(Vd_z&,0) Pbox Vd_a&+1,Vd_b&+1,Vd_a&+Vd_e1&-1-$ And And And And Imp $ Xor ;+Vd_e2&-1-$ And And And And Imp F 8 †êfÌunderline ô¥#è f $ And + And Err$( Endif If Btst(Vd_z&,1) Pbox Vd_a&+Vd_e1&+1,Vd_b&+1,Vd_a&+Eccsizex&-1-1,Vd_b&+Vd_e2&-1-1 Endif If Btst(Vd_z&,2) Pbox Vd_a&+1,Vd_b&+Vd_e2&+1,Vd_a&+Vd_e1&-1-$ And And And And Imp $ Xor ;+2*Vd_e2&-1-1 Endif If Btst(Vd_z&,3) Pbox Vd_a&+Vd_e1&+1,Vd_b&+Vd_e2&+1,Vd_a&+Eccsizex&-1-1,Vd_b&+2*Vd_e2&-1-1 Endif If Btst(Vd_z&,4) Pbox Vd_a&+1,Vd_b&+2*Vd_e2&+1,Vd_a&+Vd_e1&-1-1,Vd_b&+Eccsizey&-1-1 Endif If Btst(Vd_z&,5) Pbox Vd_a&+Vd_e1&+1,Vd_b&+2*Vd_e2&+1,Vd_a&+Eccsizex&-1-1,Vd_b&+Eccsizey&-1-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_curs&,Y_curs&),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(Shr(Vd_c&,8)),&X1100) Case 0 ! normal Select And(Byte(Shr(Vd_c&,8)),&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(Shr(Vd_c&,8)),&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(Shr(Vd_c&,8)),&X11) Case 0 ! all good Vdp_w&=0 Vdp_h&=0 Case &X1 ! dble hauteur Vdp_w&=0 Vdp_h&=1 If And(Byte(Shr(Vd_c&,8)),&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(Shr(Vd_c&,8)),&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(Shr(Vd_c&,8)),&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&+Vd_sizw&-1,Vd_b&+Vd_sizh&-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_curs+Emx&),@Wyacoord(4,Eccsizey&*y_curs+Emy&)) Gosub Xdbox ' If Btst(Vida|(X_curs&,Y_curs&),7) Vd_index&=0 ! fonte drcs G0'G1' Else Vd_index&=1 ! jeu en rom G0G1 choisi (non drcs) Endif ' Vd_b2&=-(Btst(Vida|(X_curs&,Y_curs&),4)) ! graph? For Vd_a2&=(Vd_part1! And Vd_part2!)*-5 To 9+(Vd_part3! And Vd_part4!)*5 ! 10 lignes Vd_z&=Edrcs|(Vd_index&,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(Shr(Vd_c&,8)),&X11)) Text Vd_a&+Vd_w&,Vd_b&+Vd_h&+Decalt&(And(Shr(Vd_c&,8),&X11)),Chr$(Vd_c&) Endselect $S% ' ' Pour cache: Add Vd_a&,Vd_w& Add Vd_b&,Vd_h& ' If Btst(Vida|(X_curs&,Y_curs&),1) If Imp(Emulm|=0,Btst(Vida|(X_curs&,Y_curs&),4)=False) ! NOT graphique Select And(Byte(Shr(Vd_c&,8)),&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&-1,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_curs,y_curs) Get_cache Endif Endif ' Endif ! test put cache ' Endif ! tester 'F' / 'C' ' ' Endif ! idem \/ ' Endif ! test d‚passement ' ' ' ' ' ' Traitement photographique Else ' Vd_c&=Vidp|(X_curs&,Y_curs&) ' ' En cas d'‚crasement de m‚moire... If Po%(Vd_c&)>0 ! Image recalcul‚e dispo! If Long{Po%(Vd_c&)}<>Pzo%(Vd_c&) ! Mais ‚cras‚e! Gosub Unxg(Vd_c&) ! recalculer alors! Endif Endif ' If Po%(Vd_c&)>0 ! Image recalcul‚e dispo! ' ' V‚rifier le premier long mot en cas d'‚crasement! If Long{Po%(Vd_c&)}=Pzo%(Vd_c&) G_s%(0)=Po%(Vd_c&)+4 ! adresse G_s%(1)=Word{Po%(Vd_c&)} ! largeur g‚n G_s%(2)=Word{Po%(Vd_c&)+2} ! hauteur g‚n G_s%(3)=G_s%(1)\16 If And(G_s%(1),&X1111)<>0 Inc G_s%(3) Endif G_s%(4)=0 G_s%(5)=Plans& ' R_d%(4)=Vd_a& ! idem R_d%(5)=Vd_b& R_d%(6)=Vd_a&+8-1 R_d%(7)=Vd_b&+10-1 R_d%(0)=(X_curs&-Px&(Vd_c&))*Eccsizex& R_d%(1)=(Y_curs&-Py&(Vd_c&))*Eccsizey& R_d%(2)=R_d%(0)+Eccsizex&-1 R_d%(3)=R_d%(1)+Eccsizey&-1 R_d%(8)=Set_putmode& ! mode gr ' Bitblt G_s%(),G_screen%(),R_d%() ! Vdi Raster Copy ; Opaque Else ' ..ne rien faire! Emtechinfo("-Erreur transfert image agrandie!") ' Endif ' Else if Pa%(Vd_c&)>0 ! ERROR si ici (ou image non agrandie..) ' If Long{Pa%(Vd_c&)}=Pza%(Vd_c&) G_s%(0)=Pa%(Vd_c&)+4 ! adresse G_s%(1)=Word{Pa%(Vd_c&)} ! largeur g‚n G_s%(2)=Word{Pa%(Vd_c&)+2} ! hauteur g‚n G_s%(3)=G_s%(1)\16 If And(G_s%(1),&X1111)<>0 Inc G_s%(3) Endif G_s%(4)=0 G_s%(5)=Plans& ' R_d%(4)=Vd_a& ! idem R_d%(5)=Vd_b& R_d%(6)=Vd_a&+Min(8,Eccsizex&)-1 R_d%(7)=Vd_b&+Min(10,Eccsizey&)-1 R_d%(0)=(X_curs&-Px&(Vd_c&))*8 R_d%(1)=(Y_curs&-Py&(Vd_c&))*10 R_d%(2)=R_d%(0)+Min(8,Eccsizex&)-1 R_d%(3)=R_d%(1)+Min(10,Eccsizey&)-1 R_d%(8)=Set_putmode& ! mode gr ' Bitblt G_s%(),G_screen%(),R_d%() ! Vdi Raster Copy ; Opaque Else Emtechinfo("-Erreur transfert image originale!") ' Ne rien faire! Endif ' Endif ' Endif ' ' Return $P> ' Set color, fond et text - X& et Y& ' $P< Procedure Vfond ' Local N& ' Vf_n& ' ' Abs(Btst(Vida|(x&,y&),0))=clignotant ou non! ' If Emulm|=0 $S& Select Emulm| ! mˆme EN VT100 Case 0,3 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))) Xd_c2&=Tcol&(Vf_n&) 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 ' Default 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 ! vert, 60% luminance 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&)) Endselect Return Procedure Vtext ' Local N& ' Vf_N& ' $S& Select Emulm| ! mˆme EN VT100 ' If Emulm|=0 Case 0,3 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))) Xd_c1&=Tcol&(Vf_n&) Gosub Deftextcol(Xd_c1&) Gosub Color(Xd_c1&) Gosub Deffill(Xd_c1&,1,1)! (graph) Endif ' If Emulm|=3 Clr Xd_at& If Btst(Vida|(Vf_x&,Vf_y&),2) ! gras? Xd_at&=Bset(Xd_at&,0) Endif If Btst(Vida|(Vf_x&,Vf_y&),6) ! light? Xd_at&=Bset(Xd_at&,1) Endif If Btst(Vida|(Vf_x&,Vf_y&),7) ! skweed? Xd_at&=Bset(Xd_at&,2) Endif ' If Act_atext&<>Xd_at& @Deftextattrb(Xd_at&) Endif Else If Act_atext&<>0 @Deftextattrb(0) Endif Endif ' Default 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))) Xd_c1&=Tcol&(Vf_n&) Gosub Deftextcol(Xd_c1&) Gosub Color(Xd_c1&) Gosub Deffill(Xd_c1&,1,1)! (graph) ' Endselect ' If Xd_c1&=Xd_c2& ! Invisible! If Finv|=1 ! voir! If Not (Emulm|=0 And Btst(Vida|(Vf_x&,Vf_y&),4)) ! graph Select Vf_n& Case 0 To 3 Vf_n&=7 Case 4 To 7 Vf_n&=0 Endselect Xd_c1&=Tcol&(Vf_n&) ' Gosub Deftextcol(Xd_c1&) Gosub Color(Xd_c1&) Gosub Deffill(Xd_c1&,1,1) ! (graph) Endif Endif Endif ' Return $P> ' ' ' Protection Function Repak1(E$) Return Shl(@Unchar322(Asc(Left$(E$,1))),4)+@Unchar322(Asc(Right$(E$,1))) ' Endfunc ' ' ' 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& ' If True 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 (trŠs fort!) Ptsin(0)=0 ! Coord src Ptsin(1)=0 ' Ptsin(2)=Drbitw&-1 ! Coord src Ptsin(2)=Eccsizex&-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(6)=Vd_a&+Eccsizex&-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)) ' G_s&(0)=Word(Swap(V:Drbit|(0))) G_s&(1)=Word(V:Drbit|(0)) Vdisys ! EXECUTER! ' @Lshowm Endif ' Return $P> ' ' ' Cache get (‚mulateur) $P< Procedure Get_cache ' Procedure Get_cache(A%,B%,X&,y_curs&) ' Local C$ ' ' ' SystŠme du roving pointer: on tourne en rond, les donn‚es les plus fraŒches ' sont dispo en premier. (Optimisation) ' ' Gosub Cget(Vd_a&,Vd_b&,Caches%+Cachexx%*Rovcach&) ## ' If Vd_b&+Cachey&<=H_gdesk% And Cachex&>0 And Cachey&>0 If Vd_b&+Cachey&<=H_gdesk% G_s%(0)=Caches%+Rovcach&*Cachexx% ! placer adresse G_s%(1)=Cachex& G_s%(2)=Cachey& G_s%(3)=(Cachex&+15)\16 G_s%(4)=0 G_s%(5)=Plans& R_d%(0)=Vd_a& R_d%(1)=Vd_b& R_d%(2)=Vd_a&+Cachex&-1 R_d%(3)=Vd_b&+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 ' ' ' cache$(Rovcach&)=Gc_c$ Cachs&(Rovcach&)=Vids&(X_curs&,Y_curs&) Cachc&(Rovcach&)=Vidc&(X_curs&,Y_curs&) ' Cacha|(Rovcach&)=Bclr(Bclr(Vida|(X_curs&,y_curs&),6),5) If Emulm|=0 Cacha|(Rovcach&)=And(Vida|(X_curs&,Y_curs&),&X10011111) Else Cacha|(Rovcach&)=Vida|(X_curs&,Y_curs&) Endif ' Pc_a&=Rovcach& ' Inc Rovcach& If Rovcach&>Ncach& ! Le roving fait une boucle (et ron et ron..) Rovcach&=0 Endif ' Clr Gc_c$ Endif ' Return $P> ' ' Cache put (idem) $P< Function Put_cache $F% ' Function Put_cache(A&,B&,x_curs&,y_curs&) ! Vd_a/b,X,Y ' Local A& ' Pc_a& ' ' If Btst(Bios(11,-1),1) ! shift ' Return False ' Endif ' If Byte(Vids&(X_curs&,Y_curs&))=32 ! Espace? ' If And(Vida|(x_curs&,y_curs&),&X1010)=0 ! Pas de line ni inv If And(Vida|(X_curs&,Y_curs&),&X10)=0 ! Pas de line ' @Lhidem ' Bndary(0) ## If Set_boundary&<>0 Contrl(0)=104 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=0 Vdisys Set_boundary&=0 Endif ' ' If Byte(Vidc&(x_curs&,y_curs&))=0 ! Fond ' ' Gosub Deffill(Fcol&(0),Fstyl|(0),Findex|(0)) ! Stndrd ' Else ' ' Vfond(x_curs&,y_curs&) ! Fond sp‚cial.. ' Vf_x&=X_curs& Vf_y&=Y_curs& Vfond ' Endif ' Pbox Vd_a&,Vd_b&,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey&-1) ! Box standard! Pbox Vd_a&,Vd_b&,Vd_a&+Eccsizex&-1,Vd_b&+Eccsizey&-1 ! Box standard! ' @Lshowm Return True Endif Endif ' ' Filtrage attrb. If Emulm|=0 Pc_m|=&X10011111 ! pas inhibiteurs etc.. Else Pc_m|=&HFF ! tous ok If Btst(Vida|(X_curs&,Y_curs&),7) Return False ! Italique non "cachable" … cause du d‚bordement.. Endif Endif ' ' Ancien Pc_a ? ->Rapide et ‚vite C:Swcach%() If Vids&(X_curs&,Y_curs&)=Cachs&(Pc_a&) If Vidc&(X_curs&,Y_curs&)=Cachc&(Pc_a&) If And(Vida|(X_curs&,Y_curs&),Pc_m|)=Cacha|(Pc_a&) ' ' @Cput(Vd_a&,Vd_b&,Caches%+Pc_a&*Cachexx%) ## ' --- If Vd_b&<=H_gdesk% G_s%(0)=Caches%+Pc_a&*Cachexx% ! placer adresse G_s%(1)=Cachex& ! w et h G_s%(2)=Cachey& G_s%(3)=Cachex&\16 If And(Cachex&,&X1111)<>0 Inc G_s%(3) Endif G_s%(4)=0 G_s%(5)=Plans& R_d%(4)=Vd_a& ! idem R_d%(5)=Vd_b& R_d%(6)=Vd_a&+Cachex&-1 R_d%(7)=Vd_b&+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 Endif ' --- ' Return True Endif Endif Endif ' Pc_a&=C:Cache%(W:Vids&(X_curs&,Y_curs&),W:Vidc&(X_curs&,Y_curs&),W:And(Vida|(X_curs&,Y_curs&),Pc_m|),L:V:Cachs&(0),L:V:Cachc&(0),L:V:Cacha|(0),W:Ncach&) If Pc_a&=>0 If Pc_a&<=Ncach& ' ' @Cput(Vd_a&,Vd_b&,Caches%+Pc_a&*Cachexx%) ## ' --- If Vd_b&<=H_gdesk% G_s%(0)=Caches%+Pc_a&*Cachexx% ! placer adresse G_s%(1)=Cachex& ! w et h G_s%(2)=Cachey& G_s%(3)=Cachex&\16 If And(Cachex&,&X1111)<>0 Inc G_s%(3) Endif G_s%(4)=0 G_s%(5)=Plans& R_d%(4)=Vd_a& ! idem R_d%(5)=Vd_b& R_d%(6)=Vd_a&+Cachex&-1 R_d%(7)=Vd_b&+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 Endif ' --- ' ' Return True Else ~@Form_error(1,"[3][Attention!|Erreur grave d‚tect‚e|GPUT/Cache: d‚bordement|A signaler..][ Je note ]") ~@Form_error(1,"[3][Gcache_ext=#"+Str$(Pc_a&)+"|$"+Hex$(Pc_a&,4)+"][ A‹e ]") Endif Else Pc_a&=Rovcach& Endif ' Return False Endfunc $P> ' ' Dessiner etat curseur (afficher d‚sactiv‚ ou non) Procedure Vcurs(Flag!) ' Local A%,B% ' ' 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 Ncurs! If Flag!=False And Vcr!=True Vcr!=False ' Vdraw(X_curs&,Y_curs&) Vdraw00 ' Else if Flag!=True And Vcr!=False Else if Flag!=True Vc_a&=Eccsizex&*X_curs&+Emx&-Start_x%(4)+W_ix&(4) Vc_b&=Eccsizey&*Y_curs&+Emy&-Start_y%(4)+W_iy&(4) ' Vcr!=True Inc Vcr| If Vcr|=>Min(Nbrcol&,16) Vcr|=1 Endif ' If Emulm|=0 @Bndary(0) Vcr|=1 Gosub Deffill(Vcr|,1,1) If Vcr|=1 Graphmode 3 Endif Pbox Vc_a&,Vc_b&,Vc_a&+Eccsizex&-1,Vc_b&+Eccsizey&-1 If Vcr|=1 Graphmode 1 Endif Else @Bndary(0) Gosub Deffill(Tcol&(7),1,1) Pbox Vc_a&,Vc_b&+Eccsizey&-2,Vc_a&+Eccsizex&-1,Vc_b&+Eccsizey&-1 Endif ' Endif Endif ' Endif ' Endif If Flag! ! sinon pas la peine! @Sweety_text Endif ' Return ' Redraw cursor Procedure Drcurs(Flag!) Local A&,Rx&,Ry&,Rw&,Rh&,X2& Local X&,Y&,W&,H& Local A! ' ' Fenˆtre ouverte? If Wopen!(4) X&=Eccsizex&*X_curs&+Emx&-Start_x%(4)+W_ix&(4) Y&=Eccsizey&*Y_curs&+Emy&-Start_y%(4)+W_iy&(4) W&=Eccsizex& H&=Eccsizey& A!=Vcr! ' @Lhidem A&=@Wind_update01(-1) If A&=0 ' ..Verouillage du GEM ~@Wind_update01(1) Endif Clr X2& ~Wind_get(Whandle&(4),11,Rx&,Ry&,Rw&,Rh&) While Rw&>0 ' If Rc_intersect(X&,Y&,W&,H&,Rx&,Ry&,Rw&,Rh&) ' Gosub Redraw(4,Rx&,Ry&,Rw&,Rh&) Vcr!=A! @Vcurs(Flag!) Endif ~Wind_get(Whandle&(4),12,Rx&,Ry&,Rw&,Rh&) ' Wend If A&=0 ! Restaurer situation ' ..D‚v‚rouillage du GEM ~@Wind_update01(0) Endif @Lshowm Endif ' Return $P< Procedure Vcurs0 If Ncurs! If Vcr! Vcurs(False) Endif Endif Return Procedure Vcurs1 If Ncurs! If Not Vcr! Vcurs(True) Endif Endif Return $P> ' ' * * Routine g‚n‚rale de dessin fenˆtre * * Procedure Emuledraw(X&,Y&,W&,H&) Local X2&,Y2&,A! ' @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 ' If Rafale! ! affichage rafale! ' X2&=X& Repeat A!=True If Vidp|(X2&,Y2&)=0 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 Y2&<>0 Or X2&<>F_c& A!=False Endif Endif Endif Endif Endif If Not A! Inc X2& Endif Until A! Or X2&>X&+W& ' ' Linedraw(False,X&,Y2&,W&+1) ! ne pas traiter Vidrd| If X2&<=X&+W& Linedraw(False,X2&,Y2&,W&+1) ! ne pas traiter Vidrd| Endif ' Else ! affichage classique For X2&=X& To X&+W& ' If Vidp|(X2&,Y2&)=0 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' If Y2&=0 And X2&=F_c& Vdraw(X2&,Y2&) Endif Else Vdraw(X2&,Y2&) Endif Else Vdraw(X2&,Y2&) Endif Else Vdraw(X2&,Y2&) Endif Else Vdraw(X2&,Y2&) Endif Next X2& Endif ' Next Y2& Endif ' @Sweety_text @Lshowm Return ' ' RafraŒchir ‚cran, optimis‚ avec Linedraw Procedure Vrefresh Local A&,B&,C&,N& Local X&,Y&,W&,H& Local Rx&,Ry&,Rw&,Rh& Local Flag! ' ' Wind_clip(4) Sw_clip If Vidrdall! ! cls! ' 'Rdw_all(4) ' Redessiner! X&=X_desk& Y&=Y_desk& W&=W_desk& H&=H_desk& If Rc_intersect(W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4),X&,Y&,W&,H&) Draw_e(X&,Y&,W&,H&) Endif ' ' Else Flag!=@W_tstview(4) ! fenˆtre visible ' If Vidrdexe! ! cls … effectuer! Gosub Vcls_draw Vidrdexe!=False Endif ' If Vidrdl&<>0 ! d‚calage standard … effectuer! If Flag! ! fenˆtre visible If Vidrdl&>0 ! >0 insert Insline(0,1,Vidrdl&,1) Else if Vidrdl&<0 Vidrdl&=-Vidrdl& Delline(0,1,Vidrdl&,1) Endif ' Else ! non visible: redraw Gosub Rdw_all(4) Endif Clr Vidrdl& Endif ' @Hidem ' For B&=0 To Vmax_y& ' For A&=0 To Vmax_x& Clr N& ! offset 0 Repeat N&=C:Find0%(L:V:Vidrd|(0,0),L:N&,L:100*51) ' If N&=>0 And N&<100*51 A&=Mod(N&,100) B&=Div(N&,100) If A&<=Vmax_x& And B&<=Vmax_y& If Vidrd|(A&,B&)<>0 ! sinon ya un blŠme!!! C&=Vmax_x& While (Vidrd|(C&,B&)=0) Dec C& Wend ' If Flag! ! on voit tout Linedraw(True,A&,B&,C&-A&+1) ! traiter Vidrd| Else ' ~Wind_get(Whandle&(4),11,Rx&,Ry&,Rw&,Rh&) While Rw&>0 If Rc_intersect(W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4),Rx&,Ry&,Rw&,Rh&) @Clip(Rx&,Ry&,Rw&,Rh&) Linedraw(True,A&,B&,C&-A&+1) ! traiter Vidrd| Endif ~Wind_get(Whandle&(4),12,Rx&,Ry&,Rw&,Rh&) Wend Endif ' ' Inc N& ! Offset Add N&,C&-A&+1 ! sauter Else N&=-1 ! ne devrait jamais arriver! Endif Else Inc N& Endif Else N&=-1 ! pas utile mais bon.. Endif Until N&<0 Or N&=>100*51 ' Next A& ' Next B& @Showm Endif Gosub Vid_rst(True) ' Return Procedure Vid_rst(Flag!) Local X& ' Dim Tempo&(Vmax_x&) Vidrdexe!=False Vidrdall!=False Viddec!=False ! pas de d‚coupage de page pour l'instant Clr Vidrdl& If Not Flag! For X&=0 To Vmax_x& Tempo&(X&)=Vidrd|(X&,0) Next X& Endif Arrayfill Vidrd|(),False ! fait! If Not Flag! For X&=0 To Vmax_x& Vidrd|(X&,0)=Tempo&(X&) Next X& Endif ' Erase Tempo&() Return ' ' ' Placer un fichier JPEG[Adr%,Len%] en X,Y - tout est g‚r‚ Procedure Pho_put(Adr%,Len%,X&,Y&,W&,H&,Flag!) Local A&,B& Local Adr2% Local A! ' If Rim%>0 And Trm%>0 ' ' Oui, pas la peine encore de dupliquer! Adr2%=Adr% ' If Adr2%>0 Gosub Defmouse(2) @Eminfo("D‚codage de l'image photo en cours.. -") ' Bmove Adr%,Adr2%,Len% ' @Showm Pa%(Np&)=@Transf(Adr2%,Len%) ' ** ~@Mfree(Adr2%) ' If Pa%(Np&)>0 @Eminfo("D‚codage de l'image photo en cours.. |") ' Px&(Np&)=X& ! coord vid‚otextes Py&(Np&)=Y& ' Noter premier long en cas d'‚crasement! Pza%(Np&)=Long{Pa%(Np&)} ' Po%(Np&)=@Xgtrnsf(Pa%(Np&)) ! Agrandir/r‚tr‚cir l'image If Po%(Np&)<0 Gosub Err.info("Erreur de d‚codage photo!") Else @Eminfo("D‚codage de l'image photo en cours.. /") ' If Po%(Np&)>0 Pzo%(Np&)=Long{Po%(Np&)} Endif ' @Lhidem ' For B&=Y& To Min(Y&+Word{Pa%(Np&)+2}\10-1,Vmax_y&) ' For A&=X& To Min(X&+Word{Pa%(Np&)}\8-1,Vmax_x&) ' If W&<=Word{Pa%(Np&)}\8 And H&<=Word{Pa%(Np&)+2}\10 A!=False ! optimisation: aff direct Else A!=True Endif ' For B&=Y& To Min(Y&+H&-1,Vmax_y&) For A&=X& To Min(X&+W&-1,Vmax_x&) If B&<=Min(Y&+Word{Pa%(Np&)+2}\10-1,Vmax_y&) And A&<=Min(X&+Word{Pa%(Np&)}\8-1,Vmax_x&) Vidp|(A&,B&)=Np& If Not Flag! Vidrd|(A&,B&)=&HFF ! redraw quand mˆme ? Else if A! Gosub Vdraw(A&,B&) Endif ' Else ! aire vide ' Vidp|(A&,B&)=0 Vids&(A&,B&)=32 Vidc&(A&,B&)=&H700 Vida|(A&,B&)=0 If Flag! Gosub Vdraw(A&,B&) Else Vidrd|(A&,B&)=&HFF ! redraw quand mˆme ? Endif Endif Next A& Next B& @Lshowm ' If Not A! If Flag! ' afficher Pho_aff(Np&,Min(X&+W&-1,Vmax_x&)-X&+1,Min(Y&+H&-1,Vmax_y&)-Y&+1) Endif Endif ' @Eminfo("D‚codage de l'image photo en cours..") Inc Np& Endif ' Endif Gosub Defmouse(0) ' Else If Adr2%=0 @Eminfo("Erreur d‚codage photo: type de codage TME inconnu!") Else @Eminfo("Erreur d‚codage photo: plus de m‚moire!") Endif Endif Else Gosub Comm.info("G","ERREUR DOSSIER PARX.SYS NON PRSENT, PHOTOS NON DCODES!!") Endif ' Return ' ' D‚coder bloc ou dupliquer en tt cas (adresse paire) Procedure Pho_dec(Var Adr%,Len%) Local Adr2%,L% Local A%,B% Local A&,B&,C&,D& ' ' Supmem%=50000+@Bitlen(320,240) ! m‚moire supp.. Clr Supmem% ' @Eminfo("Transcodage du fichier photo en cours..") Gosub Defmouse(2) Adr2%=-1 $S& Select P_mod& Case 0 ! pas de codage, juste copie Adr2%=@Malloc(Len%+Supmem%) Bmove Adr%,Adr2%,Len% Adr%=Adr2% Case 2 ! codage 4 sextets->3 octets ' L%=(Len%*3)\4+1 ! nvelle long. Adr2%=@Malloc(L%+Supmem%) If Adr2%>0 A%=0 B%=0 While Len%-A%=>4 ! plus ou ‚gal … 3 … coder ' A&=And(Byte{Adr%+A%},&X111111) B&=And(Byte{Adr%+A%+1},&X111111) C&=And(Byte{Adr%+A%+2},&X111111) D&=And(Byte{Adr%+A%+3},&X111111) ' ' pas la peine de mettre 3 var en plus! ' X&=B&+Rol(And(A&,&X110000),6-4) ' Y&=C&+Rol(And(A&,&X1100),6-2) ' Z&=D&+Rol(And(A&,&X11),6) ' Byte{Adr2%+B%}=B&+Rol(And(A&,&X110000),6-4) Byte{Adr2%+B%+1}=C&+Rol(And(A&,&X1100),6-2) Byte{Adr2%+B%+2}=D&+Rol(And(A&,&X11),6) ' Add A%,4 ! start Add B%,3 ! end Wend ' Clr A&,B&,C&,D& Select (Len%-A%) Case 0 ! ok! Case 1 ! imposs! @Eminfo("Erreur d‚codage photo en fin de bloc.. ?") Case 2 ! reste 1 octet A&=And(Byte{Adr%+A%},&X111111) B&=And(Byte{Adr%+A%+1},&X111111) ' Byte{Adr2%+B%}=B&+Rol(And(A&,&X110000),6-4) Inc B% Case 3 ! reste 2 octets A&=And(Byte{Adr%+A%},&X111111) B&=And(Byte{Adr%+A%+1},&X111111) C&=And(Byte{Adr%+A%+2},&X111111) ' Byte{Adr2%+B%}=B&+Rol(And(A&,&X110000),6-4) Byte{Adr2%+B%+1}=C&+Rol(And(A&,&X1100),6-2) Add B%,2 Endselect ' L%=B% ! patch! (1 octet de diff‚rence ‚ventuellement) ' Endif ' ' Retour: Adr%=Adr2% Len%=L% ' Case 4 ' L%=Len% ! on ne peut savoir … priori.. Adr2%=@Malloc(L%+Supmem%) If Adr2%>0 A%=0 B%=0 While Len%-A%>0 A&=And(Byte{Adr%+A%},&X1111111) Inc A% $S& Select A& Case &H7C B&=And(Byte{Adr%+A%},&X1111111) Inc A% Select B& Case &H23 To &H27 Byte{Adr2%+B%}=B&+&H58 Inc B% Case &H28 To &H78 Byte{Adr2%+B%}=B&+&H58 Inc B% Endselect Case &H7D Byte{Adr2%+B%}=&H20 Inc B% Case &H7E ! 7/14 B&=And(Byte{Adr%+A%},&X1111111) Inc A% Select B& Case &H21 To &H4F Byte{Adr2%+B%}=B&+&H50 Inc B% Case &H50 To &H6F Byte{Adr2%+B%}=B&-&H50 Inc B% Endselect Default Byte{Adr2%+B%}=A& Inc B% Endselect Wend Endif ' L%=B% ! taille r‚‚lle ' Adr%=Adr2% Len%=L% ' Default @Eminfo("Erreur d‚codage photo: type de codage TME inconnu!") Endselect ' Return ' ' ' ' Effacer partie d'image photo Procedure Pho_clr(X&,Y&,W&,H&,Flag!) Local A&,B& ' @Lhidem For B&=Y& To Y&+H&-1 For A&=X& To X&+W&-1 Vidp|(A&,B&)=0 Vids&(A&,B&)=32 Vidc&(A&,B&)=&H700 Vida|(A&,B&)=0 If Flag! Gosub Vdraw(A&,B&) Else Vidrd|(A&,B&)=&HFF ! redraw quand mˆme ? Endif Next A& Next B& @Lshowm ' Return ' Procedure Pho_aff(C&,W&,H&) Local A&,B& Local Adr% ' Adr%=Po%(C&) ! adresse If Adr%<=0 Adr%=Pa%(C&) ! adresse Endif ' If Adr%>0 Sw_clip @Lhidem A&=Eccsizex&*Px&(C&)+Emx&-Start_x%(4)+W_ix&(4) B&=Eccsizey&*Py&(C&)+Emy&-Start_y%(4)+W_iy&(4) ' G_s%(0)=Adr%+4 ! adresse G_s%(1)=Word{Adr%} ! largeur g‚n G_s%(2)=Word{Adr%+2} ! hauteur g‚n G_s%(3)=(G_s%(1)+15)\16 G_s%(4)=0 G_s%(5)=Plans& ' R_d%(4)=A& ! idem R_d%(5)=B& R_d%(6)=A&+8-1 R_d%(7)=B&+10-1 R_d%(0)=0 R_d%(1)=0 R_d%(2)=W&*Eccsizex&-1 R_d%(3)=H&*Eccsizey&-1 R_d%(8)=Set_putmode& ! mode gr ' Bitblt G_s%(),G_screen%(),R_d%() ! Vdi Raster Copy ; Opaque @Lshowm Endif ' Return ' ' Clear Screen Procedure Vcls(Flag!) Local X&,Y& ' ' Envoi.. Cls! X&=0 If Magneto&=1 If Mwait! If Okwait! ! autoris‚! Okwait!=False ! ok on se remet … z‚ro If Oktype|<>0 X&=True ! ne pas effacer!! Endif Else Okwait!=True ! pr‚venir l'envoyeur pour noter, et nous aussi! Oktype|=0 X&=True ! ne pas effacer tout de suite Endif Endif Endif ' If X&=0 If Len(Colgen$)>0 Col$=Colgen$ Gosub Set_col(True) ! palette en cours Else Gosub Set_col(False) ! systŠme Endif ' Clr Col$ ' Clr Vtransp! ' If Flag! ' @Vcurs(False) ' Endif Vcr!=False ' Clr Special& ! reset Clr_spe Photo!=False ' Clr_a0 ! effacer registres de sauvegarde! X_curs&=0 Y_curs&=1 Cnext|=&HFF Anext|=&HFF Cmnext|=&HFF Amnext|=&HFF If Emulm|=0 ! vid‚otex Acurs|=And(Acurs|,128) Else Clr Acurs| Endif ' Ccurs&=&H700 If Emulm|=3 Ccurs&=Extercol&(Termt|)*&H100+Extercol&(Termf|) ' Ccurs&=Termf|*&H100+Termt| Endif ' Tcurs|=0 ' ' Dim Tempo&((Vmax_x&+1)*3-1) For X&=0 To Vmax_x& Tempo&(X&)=Vidc&(X&,0) Tempo&((Vmax_x&+1)+X&)=Vids&(X&,0) Tempo&((Vmax_x&+1)*2+X&)=Vida|(X&,0) Next X& Arrayfill Vidc&(),Ccurs& Arrayfill Vids&(),32 If Emulm|=0 Arrayfill Vida|(),&X1000000 ! Inhibiteur pour fond XXXX Else Arrayfill Vida|(),0 Endif Arrayfill Vidterm|(),0 ! en mode terminal For X&=0 To Vmax_x& Vidc&(X&,0)=Tempo&(X&) Vids&(X&,0)=Tempo&((Vmax_x&+1)+X&) Vida|(X&,0)=Tempo&((Vmax_x&+1)*2+X&) Next X& ' Erase Tempo&() ' Arrayfill Vidp|(),0 ! plus de photos … l'‚cran Gosub Photo_clear ' ' 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& ' If Emulm|=0 ! vid‚otex ' Repassage en texte, mais est-ce du drcs?? If Dmodet! Acurs|=Bset(Acurs|,7) ! DRCS Else Acurs|=Bclr(Acurs|,7) ! TEXT Endif Endif ' If Flag! @Vcls_draw @Drcurs(False) Else Gosub Vid_rst(False) ' Arrayfill Vidrd|(),False ! plus de redraw Vidrdexe!=True ' Vidrdall!=False ' Clr Vidrdl& ' Viddec!=False ! pas de d‚coupage de page pour l'instant Endif Endif ' Return Procedure Vcls_draw ' ' Local X& Local A%,B% Local Rx&,Ry&,Rw&,Rh& ' @Sw_clip ! 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.. ' ~Wind_get(Whandle&(4),11,Rx&,Ry&,Rw&,Rh&) While Rw&>0 @Clip(Rx&,Ry&,Rw&,Rh&) If Emulm|=3 Vf_x&=0 Vf_y&=1 Gosub Vfond ! fond? ' Gosub Deffill(Fcol&(0),Fstyl|(0),Findex|(0)) ! Stndrd Else Gosub Deffill(Fcol&(0),Fstyl|(0),Findex|(0)) ! Stndrd Endif Pbox A%,B%,A%+Eccsizex&*(Vmax_x&+1)-1,B%+Eccsizey&*Vmax_y&-1 ! Box standard! Bndary(1) Gosub Vdraw(F_c&,0) ~Wind_get(Whandle&(4),12,Rx&,Ry&,Rw&,Rh&) Wend ' ' Pbox A%,B%,A%+Eccsizex&*(Vmax_x&+1)-1,B%+Eccsizey&*Vmax_y&-1 ! Box standard! ' Bndary(1) ' Gosub Vdraw(F_c&,0) @Lshowm ' ' For X&=0 To Vmax_x& ' Gosub Vdraw(X&,0) ' Next X& ' Return $P< Procedure Rst_seq ' Reset sequence Clr Special&,Em_a& Return $P> ' ' Sous routines 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 Function Ynewcurs2(C&,Flag!) $F% ' If Rmode! Or Emulm|<>0 Gosub Insline(1,1,C&,Flag!) Return C& Else Return Vmax_y&-C&+1 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 Emulm|=0 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 Endif ' Return $P< Procedure Xvdt_setme00 ' If Emulm|=0 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_curs,y_curs),5) ' ' Ccurs&=Ccurs& Or Byte(Vidc&(x_curs,y_curs)) ! ???????????????????????? ' Endif Endif Endif ' Return $P> ' ' ' ' ' * * Gestion clavier * * Function Emulek(Key&,Shift&,Flag!,Key2&) $F% Local A&,N& Local A! Local D&,K& ' ' If help! ' A&=Key& ' Gosub help(4,A&) ' Key&=A& ' ' a=0 -> annul‚ ' Endif ' If Key&=193 And Not Btst(Shift&,2) ! help Exdo!=True Clr Key& If Set_speed! Ob_state(Adr%(6),Am_cnx&)=Bclr(Ob_state(Adr%(6),Am_cnx&),3) Ob_state(Adr%(6),Am_lin&)=Bclr(Ob_state(Adr%(6),Am_lin&),3) Ob_state(Adr%(6),Am_lib&)=Bclr(Ob_state(Adr%(6),Am_lib&),3) Else Ob_state(Adr%(6),Am_cnx&)=Bset(Ob_state(Adr%(6),Am_cnx&),3) Ob_state(Adr%(6),Am_lin&)=Bset(Ob_state(Adr%(6),Am_lin&),3) Ob_state(Adr%(6),Am_lib&)=Bset(Ob_state(Adr%(6),Am_lib&),3) Endif 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 Fnc_env(8) A&=Am_cancel& Case Am_som& ! som Fnc_env(6) A&=Am_cancel& Case Am_ann& ! annul Fnc_env(4) A&=Am_cancel& Case Am_ret& ! ret Fnc_env(2) A&=Am_cancel& Case Am_rep& ! rep Fnc_env(3) A&=Am_cancel& Case Am_gui& ! guide Fnc_env(5) A&=Am_cancel& Case Am_cor& ! corr Fnc_env(7) A&=Am_cancel& Case Am_sui& ! suite Fnc_env(1) A&=Am_cancel& Case Am_env& ! envoi Fnc_env(0) A&=Am_cancel& ' 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 Gosub Dial(Char{{Ob_spec(Adr%(6),Am_co&)}}) A&=Am_cancel& ' Case Am_first& To Am_last& ! composer no tel ' If Not Btst(A&,15) Gosub Dial(Char{{Ob_spec(Adr%(6),A&)}}) A&=Am_cancel& ' Case Am_cnx& ! cnx If Set_speed! Outvid(Pro1$+"h") Pause 10 Else Atsend(Modem$(2)) A&=Am_cancel& Endif Case Am_dcn& ! d‚cnx Gosub Modcut ! couper la liaison A&=Am_cancel& ' Case Am_lin& ! prise de ligne If Set_speed! Outvid(Pro1$+"S"+Pro3$+"a\S") Pause 10 Else Atsend(Modem$(4)) A&=Am_cancel& Endif Case Am_lib& ! lib‚ration If Set_speed! Outvid(Pro1$+"W") Pause 10 Else Atsend(Modem$(5)) A&=Am_cancel& 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&=193 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&),8) Char{{Ob_spec(Adr%(7),Cv_gl&)}}=Str$((@Bitlen(Eccsizex&,Eccsizey&))*(Ncach&+1),8) Char{{Ob_spec(Adr%(7),Cv_tl&)}}=Str$(Ncach&+1,4) Exdo!=True Do A&=Byte(@Form_wdo(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&=Min(@Malloc(-1)/(@Bitlen(Eccsizex&,Eccsizey&)+4),Ncach&) Ncach&=Max(2,Ncach&) Gosub Cache_init Char{{Ob_spec(Adr%(7),Cv_ch&)}}=Str$(@Bitlen(Eccsizex&,Eccsizey&),8) Char{{Ob_spec(Adr%(7),Cv_gl&)}}=Str$((@Bitlen(Eccsizex&,Eccsizey&))*(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_wdo(7,-3) Return True ' Else if Key&=192 Gosub Intercall(True) Return True ' Else if Key&=190 Gosub Macros Return True ' Endif ' If Not Flag! A!=Redir! Redir!=False $S& Select Key& ' Case 187 To 196 Flag!=True ' Case 5,212 To 221 Flag!=True ' Case 10,13 ! [^]Enter ' If Shift&=&X110 ! CTL-SHF-ENTER Exdo!=True ' Redir!=True Char{{Ob_spec(Adr%(12),Rg_1&)}}="" Char{{Ob_spec(Adr%(12),Rg_2&)}}="-s" A&=Byte(@Form_exdo(12,0)) Ob_state(Adr%(12),A&)=Bclr(Ob_state(Adr%(12),A&),0) ~@Form_exdo(12,-3) If A&=Rg_ok& A&=Redir! Redir!=(Char{{Ob_spec(Adr%(12),Rg_2&)}}<>"-s") Send(Char{{Ob_spec(Adr%(12),Rg_1&)}}) Redir!=A& Endif Else if Shift&=&X101 ! Gosub P Else if Shift&=&X100 Send(Chr$(13)+Chr$(10)) If Affkey! ~@Infow(4,"/RETURN (CR/LF)") Endif Else If Connect! Or Set_speed! Fnc_env(0) Else Send(Chr$(13)) If Affkey! ~@Infow(4,"/Cr") Endif Endif Endif ' Case 208 ! Suite If Key2&=20480 And Btst(Shift&,2) And Emulm|=0 Send("ß") Else Fnc_env(1) Endif Case 200 ! Retour If Key2&=18432 And Btst(Shift&,2) And Emulm|=0 Send("^") Else Fnc_env(2) Endif Case 27 ! Repet Fnc_env(3) Case 225 ! Annul UNDO Fnc_env(4) Case 226 ! Help=Guide Fnc_env(5) Case 199,1990 ! ClrHome=sommaire Fnc_env(6) Case 203 ! <- If Emulm|=3 Send(Chr$(27)+"[D") If Affkey! ~@Infow(4,"/Gauche") Endif Else Fnc_env(7) Endif Case 205 ! -> Send(Chr$(27)+"[C") If Affkey! ~@Infow(4,"/Droite") Endif Case 243 ! ^<- If Key2&=29440 And Btst(Shift&,2) If Emulm|=0 Send("®") Else Send(Esc$+"[@") Endif Else Send("ó") Endif Case 244 ! ^-> If Key2&=29696 And Btst(Shift&,2) If Emulm|=0 Send("¯") Else Send(Chr$(9)) Endif Else Send("ô") Endif Case 210 ! Ins If Emulm|=3 Send(Chr$(27)+"[4h") If Affkey! ~@Infow(4,"/Insert") Endif Endif ' Case 8 ! Back Correction If Connect! Or Set_speed! Fnc_env(7) Else Send(Chr$(8)) If Affkey! ~@Infow(4,"/Backspace") Endif Endif Case 9 If Emulm|=3 Send(Chr$(9)) If Affkey! ~@Infow(4,"/Tab") Endif Endif Case 3 ! ^C cnx fin If Key2&<>11011 ! ^# If And(Shift&,&X11)=0 If Lastcc%=0 Lastcc%=1 Endif If (@Timsec(Gemdos(44))-@Timsec(Lastcc%))=0 ! <2 sec Lastcc%=0 Rst_seq ! reset sequence! Gosub Modcut ! couper la liaison ' ' Si Modcut ‚chou‚: Fnc_env(8) ! Cnx/Fin tout de mˆme Cnxf!=True ! Avis d'appui si en mode photo Else Lastcc%=Gemdos(44) ~Evnt_timer(250) Gosub Process ' If Lastcc%<>0 ! si =0 on vient de se rappeler grƒce … process! ' Fnc_env(8) ! Cnx/Fin ' Cnxf!=True ! Avis d'appui si en mode photo ' Rst_seq ! reset sequence! ' Endif Endif ' Else ! clearbin @Clearbin ! effacer buffer! Menu.info("Effacement du buffer") Endif Endif Case 32 $S& Select Magneto& Case 2,11,1 ! pause! Magn(5) Default If Affkey! ~@Infow(4,"/'"+Chr$(Key&)+"'") Endif Send(Chr$(Key&)) Endselect Case 33 To 255 Select Magneto& Case 2,1 ~@Infow(4,"Envoi en cours!") Default If Affkey! ~@Infow(4,"/'"+Chr$(Key&)+"'") Endif Send(Chr$(Key&)) Endselect ' Default Flag!=True ' Endselect $S% Redir!=A! Endif ' If Flag! $S& Select Key& Case 0 ' Case 450 Padx3!=Not Padx3! Gosub Test_menu ' Case 449 Gosub Set_pho ' Case 448 Gosub Infmem ' Case 447 Gosub Opt_save(-1) ' Case 446 Gosub Set_mdm ' ' Case 445 ' If @Form_alert(1,"[3][Red‚finir le chemin du |r‚pertoire PARX.SYS?][Confirmer|Annuler]")=1 ' Gosub Rim_uninit ' Gosub Parx_def ' Gosub Rim_init ' Endif ' Case 444 If Not Hsm! If Connect! If @Form_alert(1,"[2][Etes vous s–rs d'ˆtre |d‚connect‚s?][ Oui | Non ]")=1 Connect!=Not Connect! Endif Else If @Form_alert(1,"[2][Etes vous s–rs d'ˆtre |connect‚s?][ Oui | Non ]")=1 Connect!=Not Connect! Endif Endif If Wopen!(4) @Sw_clip Vdraw(F_c&,0) Endif Gosub Xconnect Gosub Test_menu If Wopen!(4) Sw_clip Vdraw(F_c&,0) Endif Else A!=Connect! Gosub Connect ! v‚rifier DSR/DCD If A!=Connect! If A! If @Form_alert(1,"[2][Modem connect‚|(d‚tection HSMODEM)][ Ok |Fin cnx.]")=1 If Set_speed! Outvid(Pro1$+"g") Pause 10 Else Atsend(Modem$(3)) Endif Endif Else ~@Form_alert(1,"[2][Modem d‚connect‚|(d‚tection HSMODEM)][ Ok ]") Endif Endif Endif Case 147 ! Status et r‚glages Gosub Set_eml ' Case 177 ! Init If @Form_alert(1,Var Double{\Acos(String$( Downto Cfloat(Cvs(Bin$(Cvs(Char{ As Cvs(Bin$(Mkf$( With ) As Frac(String$( Offset Min( As Char{Bin$(Mkf$(Min( With Mid$()Double{\}=Trace$Cfloat(Mkd$(Cvs( With Offset Mkf$( With :)Asin(Cfloat(Cfloat(Min( As Mkf$( With )Double{)=1 Gosub Defmouse(2) Gosub Emulm(0) Gosub Emul_uninit Gosub Emul_init ' ~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) 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 56 Select @Form_alert(1,"[2][Type 80 colonnes?|Minitel=Vid‚otex|BBS=Terminal][Vid‚otex|Terminal]") Case 1 Gosub Emulm(1) Case 2 Gosub Emulm(3) Endselect ' ~Form_dial(3,0,0,0,0,W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) Vcls_draw ' Rdw_all(4) ' Case 146 ! cls ' Gosub Emulm(Emulm|) @Vcls(True) ! pas besoin de reset donc.. ' @Vcls_draw ' ~Form_dial(3,0,0,0,0,W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) ' ' Vcls_draw ' Rdw_all(4) ' Case 152 ! curs on @Drcurs(False) Ncurs!=True @Drcurs(True) ' Case 153 ! curs off @Drcurs(False) Ncurs!=False ' Case 167 Gosub Emulcol ' 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 ' ' Transfert vdt->ascii Procedure Vdt2ascii Local N%,L% Local File$ ' If Len(Register$)>0 If Binp%>0 File$=@Fsel$("\*.TXT","","Sauver texte ascii") If Len(File$)>0 Trh&=@Fcreate(File$,0) If @Tsterr(Trh&) ~@Wind_update01(1) Fmshow("Transfert vid‚otex -> ascii") Gosub Defmouse(2) @Vcls(False) Clr L% Em_trx!=True Clr Trx$ Trx_x&=-1 Trx_y&=-1 For N%=0 To Binp%-1 Em_fl!=False Em_c&=Byte{Binair%+N%} ' Envoi ‚cran Gosub Emanage ' If Len(Trx$)=>512 Gosub Defmouse(2) ~@Fwrite(Trh&,Trx$) Add L%,Len(Trx$) Clr Trx$ Endif Next N% Ech_trx(0) Em_trx!=False If Len(Trx$)>0 ~@Fwrite(Trh&,Trx$) Add L%,Len(Trx$) Clr Trx$ Endif ~@Tsterr(@Fclose(Trh&)) @Vcls(False) Gosub Defmouse(0) ~@Wind_update01(0) Fmhide Gosub Menu.info("Texte sauv‚: "+Str$(L%)+" octets") ' Endif Endif Endif Endif Return ' ' ' Touches de fonction Procedure Fnc_env(N&) $S& ' fsend("Ý") Select N& Case 0 If Emulm|<>3 If Padx3! Fsend(Mkl$(&H1B21340D)) Else Fsend(Sep$+"A") Endif If Affkey! ~@Infow(4,"/Envoi") Endif Else Fsend(Chr$(13)) If Affkey! ~@Infow(4,"/Enter") Endif Endif Case 2 If Emulm|<>3 If Padx3! Fsend(Mkl$(&H1B22340D)) Else Fsend(Sep$+"B") Endif If Affkey! ~@Infow(4,"/Retour") Endif Else Fsend(Chr$(27)+"[A") If Affkey! ~@Infow(4,"/Haut") Endif Endif Case 3 If Emulm|<>3 If Padx3! Fsend(Mkl$(&H1B23340D)) Else Fsend(Sep$+"C") Endif If Affkey! ~@Infow(4,"/R‚p‚tition") Endif Else Fsend(Chr$(27)) If Affkey! ~@Infow(4,"/Esc") Endif Endif Case 5 If Emulm|<>3 If Padx3! Fsend(Mkl$(&H1B24340D)) Else Fsend(Sep$+"D") Endif If Affkey! ~@Infow(4,"/Guide") Endif Else Fsend(Chr$(226)) If Affkey! ~@Infow(4,"/Help") Endif Endif Case 4 If Emulm|<>3 If Padx3! Fsend(Mkl$(&H1B2F340D)) Else Fsend(Sep$+"E") Endif If Affkey! ~@Infow(4,"/Annulation") Endif Else Fsend(Chr$(27)+"[P") If Affkey! ~@Infow(4,"/Undo") Endif Endif Case 6 If Emulm|<>3 If Padx3! Fsend(Mkl$(&H1B26340D)) Else Fsend(Sep$+"F") Endif If Affkey! ~@Infow(4,"/Sommaire") Endif Else Fsend(Chr$(27)+"[H") If Affkey! ~@Infow(4,"/ClrHome") Endif Endif Case 7 If Emulm|<>3 If Padx3! Fsend(Mkl$(&H1B27340D)) Else Fsend(Sep$+"G") Endif If Affkey! ~@Infow(4,"/Correction") Endif Else If Affkey! ~@Infow(4,"/Backspace") Endif Fsend(Chr$(8)) Endif Case 1 If Emulm|<>3 If Padx3! Fsend(Mkl$(&H1B28340D)) Else Fsend(Sep$+"H") Endif If Affkey! ~@Infow(4,"/Suite") Endif Else Fsend(Chr$(27)+"[B") If Affkey! ~@Infow(4,"/Bas") Endif Endif Case 8 If Emulm|<>3 If Padx3! Fsend(Mkl$(&H1B29340D)) Else Fsend(Sep$+"I") Endif If Affkey! ~@Infow(4,"/Connexion/Fin") Endif Else Fsend(Chr$(3)) If Affkey! ~@Infow(4,"/^C") Endif ' Endif Endselect ' Return ' ' Options couleur & styles ‚mulateur Procedure Emulcol Local N&,X&,Y&,A&,B&,C&,D&,E&,M& Local X2&,Y2& Local A$ ' X2&=W_iw&(4) Y2&=W_ih&(4) ' N&=0 ! noir Ob_state(Adr%(8),N&+3)=Bset(Ob_state(Adr%(8),N&+3),4) Gosub Sel_pop(Adr%(8),Ec_inv&,Finv|+1) Gosub Sel_pop(Adr%(8),Ec_term&,Termf|+1) ! col fond term Gosub Sel_pop(Adr%(8),Ec_term2&,Termt|+1) ! col txt term Exdo!=True Do ' ' Dessiner arbre ~@Form_exdo(8,-2) ' If Not Exdo! ' Desiner objet @Hidem Clip_off ' ~Objc_offset(Adr%(8),Ec_bxr&,X&,Y&) Gosub Deffill(Fcol&(N&),Fstyl|(N&),Findex|(N&)) Pbox X&,Y&,X&+Ob_w(Adr%(8),Ec_bxr&)-1,Y&+Ob_h(Adr%(8),Ec_bxr&)-1 Gosub Emul_text(0) Graphmode 2 Clip(X&,Y&,Ob_w(Adr%(8),Ec_bxr&),Ob_h(Adr%(8),Ec_bxr&)) A$="'Inform all the troops that communications have completely broken down.' - Ashleigh Brilliant" For A&=1 To Len(A$) If Mod(A&,8)<>N& Gosub Deftextcol(Tcol&(Mod(A&,8))) Else Gosub Deftextcol(Tcol&(Mod(A&+1,8))) Endif Text X&+Eccsizex&*(A&-1),Y&+Decalt&(0),Mid$(A$,A&,1) Next A& Graphmode 1 Gosub Sweety_text Clip_off ' ~Objc_offset(Adr%(8),Ec_box&,X&,Y&) Gosub Deffill(Fcol&(N&),Fstyl|(N&),Findex|(N&)) 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 Deffill(Tcol&(N&),1,1) 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(Fcol&(N&),1,1) 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) Finv|=@State_pop(Adr%(8),Ec_inv&)-1 ' $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_exdo(8,-3) Tcol&(N&)=@Pannel(Tcol&(N&)) Case Ec_bc& ! barre select ~@Form_exdo(8,-3) Fcol&(N&)=@Pannel(Fcol&(N&)) Case Ec_ok&,0,1 ' ' V‚rifier qu'une couleur n'est pas utilis‚e "dupliquairement" (!!) C&=-1 D&=-1 For A&=0 To 7 For B&=0 To 7 If B&<>A& If Tcol&(A&)=Tcol&(B&) C&=A& D&=B& E&=0 Else if Fcol&(A&)=Fcol&(B&) C&=A& D&=B& E&=1 Endif Endif Next B& Next A& If C&=>0 If Plans&=1 ! mono, forcer A&=1 Else If E&=0 A&=@Form_alert(2,"[3][Les TEXTES minitel "+Col$(0,C&)+"|et "+Col$(0,D&)+" ont des couleurs|de fond repr‚sent‚es identiques..|Vous risquez de ne rien|voir s'afficher!][Ignorer|Corriger]") Else A&=@Form_alert(2,"[3][Les FONDS minitel "+Col$(0,C&)+"|et "+Col$(0,D&)+" ont des couleurs|de fond repr‚sent‚es identiques..|Vous risquez de ne rien|voir s'afficher!][Ignorer|Corriger]") Endif Endif If A&=1 Exit if True Endif Else Exit if True Endif Case Ec_save& Termf|=Max(0,Min(7,@State_pop(Adr%(8),Ec_term&)-1)) Termt|=Max(0,Min(7,@State_pop(Adr%(8),Ec_term2&)-1)) Gosub Save_col(-1) ' Case Ec_box& ! Select style+motif ' 1 to 36= 36 motifs+styles ' ~Objc_draw(Adr%(9),0,255,Rx&(9), &(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&) 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&) 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&) 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% ' Loop ' Termf|=Max(0,Min(7,@State_pop(Adr%(8),Ec_term&)-1)) Termt|=Max(0,Min(7,@State_pop(Adr%(8),Ec_term2&)-1)) If Termf|=Termt| ~@Form_alert(2,"[3][Les couleurs de texte et de |fond du terminal 80 colonnes|sont identiques. |Vous risquez de ne rien|voir s'afficher!][Annuler]") Termf|=0 Termt|=7 Endif ' 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 Not Nice! If Wopen!(4) Rd_all(4,W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) Endif Else Nice_size(X2&,Y2&) Endif ' Return ' Function Pannel(N&) $F% Local A&,M&,X&,Y&,S&,C& ' C&=Work_out(13) ! nbr col ' ~@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&,C&-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(C&-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&=(Max(1,C&-10)*X&)\1000 S&=Max(0,Min(C&-10,S&)) Case Em_bs& Mouse X&,Y&,A& ~Objc_offset(Adr%(26),Em_sl&,X&,A&) If Y&0 S&=Max(0,Min(C&-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 ' ' Options photo Procedure Set_pho Local A&,X&,N&,I& Local A$,F$ ' X&=Trm_1&+7 I&=0 ' If Spdp! Ob_state(Adr%(25),Pho_env&)=Bset(Ob_state(Adr%(25),Pho_env&),0) Else Ob_state(Adr%(25),Pho_env&)=Bclr(Ob_state(Adr%(25),Pho_env&),0) Endif If Accp! ! accepter photos non std Ob_state(Adr%(25),Pho_acc&)=Bset(Ob_state(Adr%(25),Pho_acc&),0) Else Ob_state(Adr%(25),Pho_acc&)=Bclr(Ob_state(Adr%(25),Pho_acc&),0) Endif If Fichp! ! sauver fichiers Ob_state(Adr%(25),Pho_svf&)=Bset(Ob_state(Adr%(25),Pho_svf&),0) Else Ob_state(Adr%(25),Pho_svf&)=Bclr(Ob_state(Adr%(25),Pho_svf&),0) Endif Gosub Sel_pop(Adr%(25),Pho_pal&,Ph_col|+1) Gosub Sel_pop(Adr%(25),Pho_opt&,Ph_opt|+1) Char{{Ob_spec(Adr%(25),Pho_mem&)}}=Str$(Ph_siz%,6) ' If @Exist(Set_path$+"SYSTEME\SWIFTELP.TRM") Ob_flags(Adr%(25),Trm_trm&)=Bset(Ob_flags(Adr%(25),Trm_trm&),0) Else Ob_flags(Adr%(25),Trm_trm&)=Bclr(Ob_flags(Adr%(25),Trm_trm&),0) Endif ' Exdo!=True Gosub Ref_pho Do A&=Byte(@Form_wdo(25,0)) Ob_state(Adr%(25),A&)=Bclr(Ob_state(Adr%(25),A&),0) ~Objc_draw(Adr%(25),A&,7,Rx&(25),Ry&(25),Rw&(25),Rh&(25)) ' $S& Select A& Case Pho_trm& ~@Form_wdo(25,-3) ' Exdo!=True Do Char{Ob_spec(Adr%(30),Trm_rim&)}=Left$(Nom_rim$,16) Char{Ob_spec(Adr%(30),Trm_trm&)}=Left$(Nom_trm$,16) A&=Byte(@Form_wdo(30,0)) Ob_state(Adr%(30),A&)=Bclr(Ob_state(Adr%(30),A&),0) ~Objc_draw(Adr%(30),A&,7,Rx&(30),Ry&(30),Rw&(30),Rh&(30)) Select A& Case Trm_1& To X& If Len(Trim$(Char{Ob_spec(Adr%(30),A&)}))>0 Exit if True Endif Case Trm_up& If I&>0 I&=I&-1 Gosub Ref_pho ~Objc_draw(Adr%(30),Trm_1&-1,7,Rx&(30),Ry&(30),Rw&(30),Rh&(30)) Endif Case Trm_dw& If Len(Char{Ob_spec(Adr%(30),Trm_1&+7)})>0 I&=I&+1 Gosub Ref_pho ~Objc_draw(Adr%(30),Trm_1&-1,7,Rx&(30),Ry&(30),Rw&(30),Rh&(30)) Endif Case Trm_rim& ~@Form_wdo(30,-3) F$=@Fsel$(Parx$+"RIM\*.RIM",Nom_rim$,"Fichier RIM *JPeG*?") If Len(F$)>0 N&=Rinstr(F$,"\") If N&>0 Nom_rim$=Mid$(F$,N&+1) Clr I& Gosub Rim_uninit Gosub Rim_init Gosub Ref_pho Endif Endif Exdo!=True Case Trm_trm& If @Exist(Set_path$+"SYSTEME\SWIFTELP.TRM") Select @Form_alert(1,"[2][|Quel TRaMeur choisir?][Standard|Swiftelp|Annuler]") Case 1 F$="PARX.TRM" Case 2 If @Exist(Set_path$+"SYSTEME\SWIFTELP.TRM") F$="SWIFTELP.TRM" Else F$="PARX.TRM" ~@Form_alert(1,"[1][Trm non trouv‚!][Annuler]") Endif Case 3 Clr F$ Endselect Else F$="PARX.TRM" Endif ~@Form_wdo(30,-3) ' ' F$=@Fsel$(Parx$+"*.TRM",Nom_trm$,"Fichier TRM?") ' F$="PARX.TRM" If Len(F$)>0 And F$<>Nom_trm$ N&=Rinstr(F$,"\") If N&>0 Nom_trm$=Mid$(F$,N&+1) Else Nom_trm$=F$ Endif Clr I& Gosub Rim_uninit Gosub Rim_init Gosub Ref_pho Endif Exdo!=True ' Default Exit if True Endselect Loop ~@Form_wdo(30,-3) If A&=>Trm_1& And A&<=X& Ph_tramp|=A&-Trm_1&+1+I& ! m‚thode de tramage Gosub Ref_pho Endif ' Exdo!=True Default Exit if True Endselect Loop ~@Form_wdo(25,-3) Gosub W_rdexe ' If A&=Pho_ok& Or A&=Pho_sv& ' Ph_col|=@State_pop(Adr%(25),Pho_pal&)-1 Ph_opt|=@State_pop(Adr%(25),Pho_opt&)-1 ' Ph_tramp|=@State_pop(Adr%(25),Pho_trm&)-1 ' Ph_siz%=Val(Char{{Ob_spec(Adr%(25),Pho_mem&)}}) Ph_siz%=Min(Malloc(-1),Max(8192,Ph_siz%)) ' Spdp!=Btst(Ob_state(Adr%(25),Pho_env&),0) Accp!=Btst(Ob_state(Adr%(25),Pho_acc&),0) Fichp!=Btst(Ob_state(Adr%(25),Pho_svf&),0) ' If A&=Pho_sv& Gosub Sv_pho Endif Endif ' Return Procedure Ref_pho Local A& Local A% Local A$ ' Char{Ob_spec(Adr%(25),Pho_trm&)}="" For A&=0 To 7 Char{Ob_spec(Adr%(30),Trm_1&+A&)}="" Next A& If Trm%>0 A%=Trm%+&H7A6+2+4 ! data+bra.l Ph_tramp|=Max(Ph_tramp|,1) For A&=0 To Min(I&+7,Word{Trm%+&H7A6}-1) If A&=>I& A$=Left$(Char{A%},30) A$=A$+Space$(30-Len(A$)) Char{Ob_spec(Adr%(30),Trm_1&+A&-I&)}=A$ Endif If A&=Ph_tramp|-1 Char{Ob_spec(Adr%(25),Pho_trm&)}=A$ Endif Add A%,32 Next A& Else Char{Ob_spec(Adr%(25),Pho_trm&)}="aucun trm charg‚!" Char{Ob_spec(Adr%(30),Trm_1&)}="aucun trm charg‚!" Endif ' Return ' ' ' Status ‚mulateur et options Procedure Set_eml Local A&,N&,M& Local X& Local A$ ' Ob_state(Adr%(39),Es_emu&)=Bclr(Ob_state(Adr%(39),Es_emu&),0) ' If Emul! If Recept! Ob_state(Adr%(39),Es_emu&)=Bset(Ob_state(Adr%(39),Es_emu&),0) Endif Else If Recept! Else Endif Endif ' If Rafale! Ob_state(Adr%(39),Es_rtm&)=Bset(Ob_state(Adr%(39),Es_rtm&),0) Else Ob_state(Adr%(39),Es_rtm&)=Bclr(Ob_state(Adr%(39),Es_rtm&),0) Endif ' If Padx3! Ob_state(Adr%(39),Es_pad&)=Bset(Ob_state(Adr%(39),Es_pad&),0) Else Ob_state(Adr%(39),Es_pad&)=Bclr(Ob_state(Adr%(39),Es_pad&),0) Endif ' If Prix! Ob_state(Adr%(39),Es_prix&)=Bset(Ob_state(Adr%(39),Es_prix&),0) Else Ob_state(Adr%(39),Es_prix&)=Bclr(Ob_state(Adr%(39),Es_prix&),0) Endif ' If Inftech! Ob_state(Adr%(39),Es_deb&)=Bset(Ob_state(Adr%(39),Es_deb&),0) Else Ob_state(Adr%(39),Es_deb&)=Bclr(Ob_state(Adr%(39),Es_deb&),0) Endif ' If Affkey! Ob_state(Adr%(39),Es_cla&)=Bset(Ob_state(Adr%(39),Es_cla&),0) Else Ob_state(Adr%(39),Es_cla&)=Bclr(Ob_state(Adr%(39),Es_cla&),0) Endif ' If Ncurs! Ob_state(Adr%(39),Es_curs&)=Bset(Ob_state(Adr%(39),Es_curs&),0) Else Ob_state(Adr%(39),Es_curs&)=Bclr(Ob_state(Adr%(39),Es_curs&),0) Endif ' If Answer! Gosub Sel_pop(Adr%(39),Es_rep&,Ansid|+1) Else Gosub Sel_pop(Adr%(39),Es_rep&,1) Endif ' Gosub Sel_pop(Adr%(39),Es_mod&,Emulm|+1) ' 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$ Char{{Ob_spec(Adr%(39),Es_pub&)}}=Pub$ Char{{Ob_spec(Adr%(39),Es_xt&)}}=Str$(Xterm&) Char{{Ob_spec(Adr%(39),Es_yt&)}}=Str$(Yterm&) ' Exdo!=True Do A&=Byte(@Form_wdo(39,0)) Ob_state(Adr%(39),A&)=Bclr(Ob_state(Adr%(39),A&),0) ~Objc_draw(Adr%(39),A&,7,Rx&(39),Ry&(39),Rw&(39),Rh&(39)) ' Select A& Case Es_rs& ! conf s‚rie Gosub Set_rs Case Es_pho& ~@Form_wdo(39,-3) Gosub Set_pho Exdo!=True Default Exit if True Endselect Loop ~@Form_wdo(39,-3) ' If A&=Es_ok& Or A&=Es_sv& If Btst(Ob_state(Adr%(39),Es_emu&),0) ! ‚muler Emul!=True Recept!=True Else Recept!=False Endif ' Ansid|=@State_pop(Adr%(39),Es_rep&)-1 If Ansid|=0 Answer!=False ! ne r‚pondre … RIEN alors Else Answer!=True Endif ' If Btst(Ob_state(Adr%(39),Es_cn&),0) Connect!=True Else Connect!=False Endif Gosub Xconnect Gosub Test_menu If Wopen!(4) @Sw_clip Vdraw(F_c&,0) Endif ' Rafale!=Btst(Ob_state(Adr%(39),Es_rtm&),0) ' Padx3!=Btst(Ob_state(Adr%(39),Es_pad&),0) ' Prix!=Btst(Ob_state(Adr%(39),Es_prix&),0) ' Rmode!=Btst(Ob_state(Adr%(39),Es_ro&),0) ' Dmodet!=Btst(Ob_state(Adr%(39),Es_d0&),0) ' Dmodeg!=Btst(Ob_state(Adr%(39),Es_d1&),0) ' Inftech!=Btst(Ob_state(Adr%(39),Es_deb&),0) ' Affkey!=Btst(Ob_state(Adr%(39),Es_cla&),0) ' @Drcurs(False) Ncurs!=Btst(Ob_state(Adr%(39),Es_curs&),0) @Drcurs(True) ' Id$=Char{{Ob_spec(Adr%(39),Es_id&)}} Pub$=Char{{Ob_spec(Adr%(39),Es_pub&)}} ' N&=Val(Char{{Ob_spec(Adr%(39),Es_xt&)}}) M&=Val(Char{{Ob_spec(Adr%(39),Es_yt&)}}) N&=Min(Max(N&,20),100) M&=Min(Max(M&,10),50) If N&<>Xterm& Or M&<>Yterm& Xterm&=N& Yterm&=M& Endif ' N&=@State_pop(Adr%(39),Es_mod&)-1 If Emulm|<>N& ! changement de mode Emulm(N&) Endif ' If A&=Es_sv& Gosub Opt_save(&X1) Endif ' Endif ' Return ' Procedure Set_rs Local X& Local A$ ' If Speed&=4 A$=Rsdefv$ X&=@Confrs(A$) If X&=1 ! vdt Rsdefv$=A$ Else if X&=2 Rsdef$=A$ Endif Gosub Setspeed Else ~@Form_alert(1,"[3][R‚glage pr‚d‚fini avec un |minitel!][ Annuler ]") Endif Return ' Procedure Intercall(Flag!) Local O&,Mx&,My&,Mk&,Dummy&,K&,A&,N&,B&,Dummy&,Clic&,Evnmnt&,C&,Z& Local E$,A$,C$,B$ Local A!,B! Local C! Local A% Local X&,Y&,T& ' Clr A& Exdo!=True ' Clr Callinf$ Clr C$ Gosub Rdr Char{{Ob_spec(Adr%(11),Ap_id&)}}="<" ~@Form_exdo(11,-2) @Caremouse ~@Wind_update01(11) N&=0 Do Clr K& ' ~Graf_mkstate(Mx&,My&,Mk&,K&) @Mouse(Mx&,My&,Mk&) If Bios(1,2) A%=Bios(2,2) K&=Byte(A%) If K&=0 K&=Byte(Swap(A%)+&H80) Endif Endif ' Evnmnt&=Evnt_multi(&X11,256+3,3,0,0,0,0,0,0,0,0,0,0,0,Varptr(Wmenu&(0)),0,Mx&,My&,Mk&,Dummy&,K&,Clic&) ' ' If Not Btst(Evnmnt&,0) ' Clr K& ' Else ' K&=@Geminp(K&) ' Endif ' If Not Btst(Evnmnt&,1) ' Clr Mk& ' Endif ' ' If Inp?(2) ' K&=Inp(2) ' Else ' Clr K& ' Endif ' @Mouse(Mx&,My&,Mk&) ' Clr A& If K&>0 Select K& Case 8 If Len(E$)>0 E$=Left$(E$,Len(E$)-1) If Len(E$)=0 Clr N& Gosub Rdr ~Objc_draw(Adr%(11),Ap_l1&-1,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) ~Objc_draw(Adr%(11),Ap_bs&,255,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) Endif Endif Case 27 Clr E$ Clr N& Gosub Rdr ~Objc_draw(Adr%(11),Ap_l1&-1,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) ~Objc_draw(Adr%(11),Ap_bs&,255,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) Case 225 A&=Ap_ann& ' Case 13,10 If Flag! If @Tstn(E$) A&=Ap_ok& Else If Len(C$)=0 If Btst(Ob_state(Adr%(11),Ap_l1&),0) ' E$=Call$(N&) A&=Rinstr(E$," ") If A&>0 Callinf$=Left$(E$,A&-1) E$=Mid$(E$,A&+1) Endif A&=Ap_ok& C$=E$ ' C$=Char{Ob_spec(Adr%(11),Ap_l2&)} Endif Endif ' If Len(C$)>0 E$=C$ A&=Ap_ok& Else A&=Ap_ann& ' @Beep Endif Endif Else A&=Ap_ok& Endif ' Case 200 If N&>0 N&=Max(0,N&-1) Gosub Rdr ~Objc_draw(Adr%(11),Ap_l1&-1,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) ~Objc_draw(Adr%(11),Ap_bs&,255,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) Endif Case 208 If Len(Call$(N&))>0 N&=Min(Maxr&-8,N&+1) ' N&=Min(Z&,N&+1) Gosub Rdr ~Objc_draw(Adr%(11),Ap_l1&-1,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) ~Objc_draw(Adr%(11),Ap_bs&,255,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) Endif Case 64,205,203 Case 32 If Len(E$)>0 And (Not @Tstn(E$)) E$=E$+Chr$(K&) Endif Case "0" To "9",",","/" E$=E$+Chr$(K&) Case 33 To 255 If (Not @Tstn(E$)) Or (Instr(E$,"/")>0) E$=E$+Chr$(K&) Else E$=E$+"/"+Chr$(K&) Endif Default @Beep Endselect ' Char{{Ob_spec(Adr%(11),Ap_id&)}}=Left$(E$+"<",16) ~Objc_draw(Adr%(11),Ap_id&,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) ' If (Not @Tstn(E$)) B!=False ' If Len(E$)>0 ' Clr C$ For A&=0 To Maxr& A$=Call$(A&) Exit if Len(A$)=0 B&=Rinstr(A$," ") If B&>0 A$=Left$(A$,B&-1) If Upper$(Left$(A$,Len(E$)))=Upper$(E$) B$=Char{Ob_spec(Adr%(11),Ap_l1&)} If Upper$(Left$(B$,Len(E$)))<>Upper$(E$) ! d‚ja ' C$=@Ccut$(Mid$(Call$(A&),B&+1)) C$=Mid$(Call$(A&),B&+1) N&=A& Gosub Rdr B!=True Exit if True Else B!=True A$=" " Exit if True ' Endif Endif Endif Next A& If Len(A$)=0 If Len(E$)=>3 For A&=0 To Maxr& A$=Call$(A&) Exit if Len(A$)=0 B&=Rinstr(A$," ") If B&>0 A$=Left$(A$,B&-1) If Instr(Upper$(A$),Upper$(E$))<>0 ' C$=@Ccut$(Mid$(Call$(A&),B&+1)) C$=Mid$(Call$(A&),B&+1) N&=A& Gosub Rdr B!=True Exit if True Endif Endif Next A& Endif Endif ' Clr A& Endif ' Endif ' If Bset(Ob_state(Adr%(11),Ap_l1&),0)<>B! If B! Ob_state(Adr%(11),Ap_l1&)=Bset(Ob_state(Adr%(11),Ap_l1&),0) Ob_state(Adr%(11),Ap_l2&)=Bset(Ob_state(Adr%(11),Ap_l2&),0) Else Ob_state(Adr%(11),Ap_l1&)=Bclr(Ob_state(Adr%(11),Ap_l1&),0) Ob_state(Adr%(11),Ap_l2&)=Bclr(Ob_state(Adr%(11),Ap_l2&),0) Endif ~Objc_draw(Adr%(11),Ap_l1&-1,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) Endif ' Endif ' ' If Mk&=1 O&=Objc_find(Adr%(11),0,7,Mx&,My&) If O&=>0 If Not Btst(Ob_state(Adr%(11),O&),14) ! D‚placer formulaire ~Objc_offset(Adr%(11),O&,Rx&,Ry&) If And(Ob_flags(Adr%(11),O&),&X1001111)<>0 ! selectable (exit,texit,editable etc) ' If And(Ob_flags(Adr%(11),O&),&X1)<>0 Ob_state(Adr%(11),O&)=Bchg(Ob_state(Adr%(11),O&),0) ' Gosub Rd_all(Wdial&,Rx&-2,Ry&-2,Ob_w(Adr%(11),O&)+4,Ob_h(Adr%(11),O&)+4) ~Objc_draw(Adr%(11),O&,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) If Not Btst(Ob_flags(Adr%(11),O&),6) @Caremouse Endif ' Endif ' If And(Ob_flags(Adr%(11),O&),&X1000110)<>0 ! exit ~Graf_mkstate(Mx&,My&,Mk&,Dummy&) If O&=Objc_find(Adr%(11),0,7,Mx&,My&) A&=O& ! EXIT Else Ob_state(Adr%(11),O&)=Bclr(Ob_state(Adr%(11),O&),0) ' Gosub Rd_all(Wdial&,Rx&-2,Ry&-2,Ob_w(Adr%(11),O&)+4,Ob_h(Adr%(11),O&)+4) ~Objc_draw(Adr%(11),O&,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) Endif Endif ' Endif ' Endif ! XYZselect Endif ! moving object Endif ' If A&>0 If A&<>Ap_del& Ob_state(Adr%(11),A&)=Bclr(Ob_state(Adr%(11),A&),0) ~Objc_draw(Adr%(11),O&,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) Endif ' C&=-1 If C! If A&=>Ap_l1& And A&<=Ap_l1&+15 C&=(A&-Ap_l1&)\2 A&=Ap_enr& Else Gosub Defmouse(0) Endif C!=False Endif Select A& Case Ap_mod& Gosub Defmouse(3) C!=True ' Case Ap_sl& X&=Graf_slidebox(Adr%(11),Ap_bs&,Ap_sl&,1) ! g‚rer slide N&=(Max(1,Z&-8)*X&)\1000 N&=Max(0,Min(Z&-8,N&)) Gosub Rdr ~Objc_draw(Adr%(11),Ap_l1&-1,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) ~Objc_draw(Adr%(11),Ap_bs&,255,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) @Waitmouse ' Case Ap_bs& Mouse X&,Y&,T& ~Objc_offset(Adr%(11),Ap_sl&,X&,T&) If Y&0 N&=Max(0,N&-1) Gosub Rdr ~Objc_draw(Adr%(11),Ap_l1&-1,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) ~Objc_draw(Adr%(11),Ap_bs&,255,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) Endif Case Ap_dw& If Len(Call$(N&))>0 N&=Min(Maxr&-8,N&+1) N&=Min(Z&-8,N&+1) Gosub Rdr ~Objc_draw(Adr%(11),Ap_l1&-1,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) ~Objc_draw(Adr%(11),Ap_bs&,255,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) Endif Case Ap_enr& ' ~@Form_exdo(11,-3) Clr B$ Char{{Ob_spec(Adr%(12),Rg_1&)}}="" Char{{Ob_spec(Adr%(12),Rg_2&)}}="" If C&=>0 Char{{Ob_spec(Adr%(12),Rg_1&)}}=Char{Ob_spec(Adr%(11),Ap_l1&+C&*2)} Char{{Ob_spec(Adr%(12),Rg_2&)}}=Char{Ob_spec(Adr%(11),Ap_l2&+C&*2)} C&=C&+N& A&=Instr(Call$(C&),Chr$(1)) If A&=>1 B$=Mid$(Call$(C&),A&+1) Endif Endif Do If Len(B$)>0 Ob_state(Adr%(12),Rg_mod&)=Bset(Ob_state(Adr%(12),Rg_mod&),2) Else Ob_state(Adr%(12),Rg_mod&)=Bclr(Ob_state(Adr%(12),Rg_mod&),2) Endif Exdo!=True A&=Byte(@Form_exdo(12,0)) Ob_state(Adr%(12),A&)=Bclr(Ob_state(Adr%(12),A&),0) ~@Form_exdo(12,-3) Select A& Case Rg_mod& ~@Confrs(B$) ' Default Exit if True Endselect Loop ' If A&=Rg_ok& A&=0 While Len(Call$(A&))<>0 And A&0 C$=Upper$(Left$(C$,1))+Mid$(C$,2) If @Tstn(Left$(C$,1)) C$="N"+C$ Endif C$=C$+" " A$=Trim$(@Ntrim$(Char{{Ob_spec(Adr%(12),Rg_2&)}})) B&=Instr(A$," ") If B&>0 And (Not @Tstn(Mid$(A$,B&+1))) Mid$(A$,B&,1)="/" Endif ' Else A$=@Xtrim$(A$) ' Endif If Len(A$)>0 If C&=>0 Delete Call$(C&) Dec A& Endif ' If Len(B$)=0 Call$(A&)=C$+" "+A$ Else Call$(A&)=C$+" "+A$+Chr$(1)+B$ Endif Clr B$ Clr C$ ' Qsort Call$(),A&+1 ! et hop! ' Gosub Opt_save(&X10) Else @Beep Endif Else @Beep Endif Endif ' Gosub Rdr Exdo!=True ~@Form_exdo(11,-2) Clr A& ' Case Ap_del& Ob_state(Adr%(11),A&)=Bclr(Ob_state(Adr%(11),A&),0) A!=True Gosub Defmouse(3) ' Case Ap_ok&,Ap_ann&,1 Case Ap_l1& To A&=(A&-Ap_l1&)\2 If A&<=7 ' If Len(Call$(N&+A&))>0 If Not A! E$=Call$(N&+A&) A&=Rinstr(E$," ") If A&>0 Callinf$=Left$(E$,A&-1) E$=Mid$(E$,A&+1) Endif A&=Ap_ok& Else Gosub Defmouse(0) A!=False Delete Call$(N&+A&) Gosub Rdr ~Objc_draw(Adr%(11),Ap_l1&-1,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) ~Objc_draw(Adr%(11),Ap_del&,7,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) ~Objc_draw(Adr%(11),Ap_bs&,255,Rx&(11),Ry&(11),Rw&(11),Rh&(11)) Endif Else Clr A& Endif ' Else Clr A& Endif @Caremouse Endselect ' Endif ' Loop until A&=Ap_ok& Or A&=Ap_ann& Or A&=1 Or Mk&=2 Gosub Defmouse(0) ~@Wind_update01(0) @Videkbd If Mk&<>2 @Caremouse Endif ' @Videkbd ~@Form_exdo(11,-3) If Mk&=2 @Caremouse Endif ' If A&=Ap_ok& And Flag! @Top(4) Gosub Dial(E$) Endif ' Return Function Confrs(Var B$) Local A&,X& ' If Len(B$)>0 A&=Val("$"+Mid$(B$,1,2)) @Sel_pop(Adr%(18),Cs_1&,Shr(And(A&,&X110),1)) ! bits/stop @Sel_pop(Adr%(18),Cs_3&,Shr(And(A&,&X11000),3)) ! bits/stop @Sel_pop(Adr%(18),Cs_2&,Shr(And(A&,&X1100000),5)+1) ! bits/car A&=Val("$"+Mid$(B$,1+2,2)) @Sel_pop(Adr%(18),Cs_4&,A&+1) ! protocole X&=Abs(Val("$"+Mid$(B$,1+4,2))=2) Endif ' Exdo!=True If X&=0 Char{Ob_spec(Adr%(18),Cs_mod&)}="Vid‚otex" Else Char{Ob_spec(Adr%(18),Cs_mod&)}="Terminal" Endif Do A&=Byte(@Form_exdo(18,0)) Ob_state(Adr%(18),A&)=Bclr(Ob_state(Adr%(18),A&),0) ~Objc_draw(Adr%(18),A&,7,Rx&(18),Ry&(18),Rw&(18),Rh&(18)) Select A& Case Cs_mod& X&=1-X& Default Exit if True Endselect If X&=0 Char{Ob_spec(Adr%(18),Cs_mod&)}="Vid‚otex" Else Char{Ob_spec(Adr%(18),Cs_mod&)}="Terminal" Endif ~Objc_draw(Adr%(18),Cs_mod&,7,Rx&(18),Ry&(18),Rw&(18),Rh&(18)) Loop ~@Form_exdo(18,-3) If A&=Cs_ok& ' Clr A& A&=Or(A&,Shl(@State_pop(Adr%(18),Cs_1&),1)) ! parit‚ A&=Or(A&,Shl(@State_pop(Adr%(18),Cs_2&)-1,5)) ! bits/car A&=Or(A&,Shl(@State_pop(Adr%(18),Cs_3&),3)) ! bits/stop A&=Bset(A&,7) B$=Hex$(A&,2) ' A&=@State_pop(Adr%(18),Cs_4&)-1 ! protocole B$=B$+Hex$(A&,2) ' B$=B$+Hex$(X&+1,2) ' Endif Return X&+1 Endfunc Deffn Tstn(A$)=(Asc(Left$(A$,1))=>48 And Asc(Left$(A$,1))<=57) ' coupe chr1 dans chaine call$ Function Ccut$(A$) Local A& ' A&=Rinstr(A$,Chr$(1)) If A&>0 Return Left$(A$,A&-1) Endif Return A$ Endfunc Procedure Rdr Local A&,B& Local A$,B$ ' Clr Z& While Len(Call$(Z&))>0 Inc Z& Wend Ob_y(Adr%(11),Ap_sl&)=((Ob_h(Adr%(11),Ap_bs&)-Ob_h(Adr%(11),Ap_sl&))*Min(N&,Max(Z&-8,$ And And And And Imp ÿ f$)\Max(1,(Z&-8)) For A&=0 To 7 Clr A$,B$ If A&<=Maxr& A$=Call$(N&+A&) B&=Rinstr(A$," ") If B&<>0 B$=Left$(A$,B&-1) ! num A$=@Ccut$(Mid$(A$,B&+1)) ! id Endif Else A$="" Endif ' Char{Ob_spec(Adr%(11),Ap_l1&+A&*2)}=Left$(B$,22) Char{Ob_spec(Adr%(11),Ap_l2&+A&*2)}=Left$(A$,14) Next A& Ob_state(Adr%(11),Ap_l1&)=Bclr(Ob_state(Adr%(11),Ap_l1&),0) Ob_state(Adr%(11),Ap_l2&)=Bclr(Ob_state(Adr%(11),Ap_l2&),0) Return Function Xtrim$(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& B$=Upper$(B$) Return B$ Endfunc Function Ntrim$(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) Else B$=B$+" " Endif Next A& B$=Upper$(B$) Return B$ Endfunc ' Trim … droite Function Rtrim$(A$) Local N& N&=Len(A$) While Asc(Mid$(A$,N&,1))=32 And N&>0 Dec N& Wend Return Left$(A$,N&) Endfunc Function Letasc$(A$) Local A& Local B$ ' A$=Upper$(A$) Clr B$ For A&=1 To Len(A$) $S& Select Asc(Mid$(A$,A&,1)) Case "A" To "Z" B$=B$+Mid$(A$,A&,1) Endselect Next A& Return B$ Endfunc Procedure Save_rep Local A&,N& Local A$ ' ~@Wind_update01(1) Fmshow("Sauvegarde du r‚pertoire") Gosub Defmouse(2) Fileh&=@Fcreate(Set_path$+"SYSTEME\"+"NUMEROS.SET",0) If @Tsterr(Fileh&) ' A$=";"+Cr$+"; R‚pertoire de num‚ros pour Swiftel III"+Cr$+";"+Cr$+Cr$ A&=0 Repeat N&=Instr(Call$(A&),Chr$(1)) If N&<=0 A$=A$+Call$(A&)+Cr$ Else A$=A$+Left$(Call$(A&),N&-1)+Cr$+"#"+Mid$(Call$(A&),N&+1)+Cr$ Endif Inc A& Until Len(Call$(A&))=0 A$=A$+Cr$ ' ~@Tsterr(@Fwrite(Fileh&,A$)) ~@Tsterr(@Fclose(Fileh&)) Endif Gosub Defmouse(0) Fmhide ~@Wind_update01(0) ' Return Procedure Save_mdm Local A& Local A$ ' ~@Wind_update01(1) Fmshow("Sauvegarde des chaines Modem") Gosub Defmouse(2) Fileh&=@Fcreate(Set_path$+"SYSTEME\"+"MODEM.SET",0) If @Tsterr(Fileh&) A$=";"+Cr$+"; Chaines Modem pour Swiftel III"+Cr$+";"+Cr$+Cr$ A&=0 For A&=0 To 5 A$=A$+Modem$(A&)+Cr$ Next A& A$=A$+Cr$ ' ~@Tsterr(@Fwrite(Fileh&,A$)) ~@Tsterr(@Fclose(Fileh&)) Endif Gosub Defmouse(0) Fmhide ~@Wind_update01(0) ' Return Procedure Sv_pho Local Fileh& Local A$ ' ~@Wind_update01(1) Fmshow("Sauvegarde des options photo") Gosub Defmouse(2) Fileh&=@Fcreate(Set_path$+"SYSTEME\"+"PHOTO.CNF",0) If @Tsterr(Fileh&) ' A$="SWP3PHO1" A$=A$+Chr$(Ph_col|)+Chr$(Ph_opt|)+Mkl$(Ph_siz%)+Chr$(Spdp!)+Chr$(Accp!)+Chr$(Fichp!)+Chr$(Ph_tramp|) ' ~@Tsterr(@Fwrite(Fileh&,A$)) ~@Tsterr(@Fclose(Fileh&)) Endif Gosub Defmouse(0) Fmhide ~@Wind_update01(0) ' ' Sauver chemin! Gosub Sv.parx ' Return ' ' Procedure Parm_test Local F$ ' If Len(Param_prg$)>0 F$=Upper$(Trim$(Param_prg$)) Param_prg$="" If @Fexist(F$) Select Right$(F$,4) Case ".SPM" ~@Macload(F$) ! load Gosub Macexe Gosub W_rdexe ' Default File$(2)=F$ @Load.vdt(1) Envoi(1) Endselect Endif Endif Return ' ' Procedure Macros Local A&,B& Local X&,Y& Local L& Local X2&,Y2& Local N& Local O& Local W&,W2& Local Adr% Local Fileh& Local File$ Local A$ Local Mac! Local A!,B! ' A!=False B!=False Mac!=True L&=-1 If (Not Mexe!) Clr P& Clr W& While Len(Mac$(W&))>0 Inc W& Wend ' Adr%=Fgetdta() For A&=0 To Nmac& ! effacer noms Macf$(A&)="" Next A& Clr A& X&=Fsfirst(Set_path$+"SYSTEME\MACROS\*.SPM",0) While X&=0 ! rechercher noms Macf$(A&)=Char{Adr%+30} Macf$(A&)=Left$(Macf$(A&),Len(Macf$(A&))-4) Inc A& ' X&=Fsnext() Wend W2&=A& ' If Mac! P&=W2& Clr N& Else P&=W& N&=Max(0,W&-9) Endif ' Ob_flags(Adr%(19),Ed_clr&)=Bset(Ob_flags(Adr%(19),Ed_clr&),7) Ob_flags(Adr%(19),Ed_mod&)=Bset(Ob_flags(Adr%(19),Ed_mod&),7) Ob_flags(Adr%(19),Ed_ld&)=Bset(Ob_flags(Adr%(19),Ed_ld&),7) ' Ob_flags(Adr%(19),Ed_sv&)=Bset(Ob_flags(Adr%(19),Ed_sv&),7) Ob_flags(Adr%(19),Ed_add&)=Bset(Ob_flags(Adr%(19),Ed_add&),7) Ob_flags(Adr%(19),Ed_run&)=Bset(Ob_flags(Adr%(19),Ed_run&),7) Char{Ob_spec(Adr%(19),Ed_new&)}="Editer" Char{Ob_spec(Adr%(19),Ed_sv&)}="Touche" ' Gosub Macrd ' Exdo!=True Do If Not (Mac! And Len(A$)>0) A&=Byte(@Form_wdo(19,0)) Desel(19,A&) Else A&=Ed_ld& Endif ' Select A& Case Ed_up& If N&>0 Dec N& Gosub Macrd ~Objc_draw(Adr%(19),Ed_box&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) Endif Case Ed_dw& If N&0 Inc N& Gosub Macrd ~Objc_draw(Adr%(19),Ed_box&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) Endif Endif Case Ed_clr& ~Objc_draw(Adr%(19),A&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) If L&=>0 If Len(Mac$(N&+L&))>0 Delete Mac$(N&+L&) Delete Maci$(N&+L&) Dec P& L&=-1 N&=Max(0,P&-9) Macrd ~Objc_draw(Adr%(19),Ed_box&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) Else L&=-1 Macrd ~Objc_draw(Adr%(19),Ed_box&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) Endif Endif Case Ed_mod& ~Objc_draw(Adr%(19),A&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) If L&=>0 If Len(Mac$(N&+L&))>0 ' ' Copie de Ed_add ~Objc_draw(Adr%(19),A&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) ~@Form_wdo(19,-3) @W_rdexe ' ' Insert commande Gosub Macins ' If Len(Mac$(P&))>0 ! ok Mac$(N&+L&)=Mac$(P&) Maci$(N&+L&)=Maci$(P&) Mac$(P&)="" Maci$(P&)="" Endif ' ' Recompter on sait jamais.. Clr P& While Len(Mac$(P&))>0 Inc P& Wend ' N&=Max(0,P&-9) Gosub Macrd Exdo!=True Else ~@Form_alert(1,"[1][S‚lectionnez une ligne|non vide!][Annuler]") Macrd ~Objc_draw(Adr%(19),Ed_box&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) Endif Else ~@Form_alert(1,"[1][S‚lectionnez une ligne!][Annuler]") Macrd ~Objc_draw(Adr%(19),Ed_box&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) Endif L&=-1 Case Ed_new& If Mac! Mac!=False Ob_flags(Adr%(19),Ed_clr&)=Bclr(Ob_flags(Adr%(19),Ed_clr&),7) Ob_flags(Adr%(19),Ed_mod&)=Bclr(Ob_flags(Adr%(19),Ed_mod&),7) Ob_flags(Adr%(19),Ed_ld&)=Bclr(Ob_flags(Adr%(19),Ed_ld&),7) ' Ob_flags(Adr%(19),Ed_sv&)=Bclr(Ob_flags(Adr%(19),Ed_sv&),7) Ob_flags(Adr%(19),Ed_add&)=Bclr(Ob_flags(Adr%(19),Ed_add&),7) Ob_flags(Adr%(19),Ed_run&)=Bclr(Ob_flags(Adr%(19),Ed_run&),7) Char{Ob_spec(Adr%(19),Ed_new&)}="Nouveau" Char{Ob_spec(Adr%(19),Ed_sv&)}="Sauver" P&=W& N&=Max(0,W&-9) Macrd Rdw_all(Wdial&) Else ~Objc_draw(Adr%(19),A&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) If @Form_alert(1,"[2][Effacer macro?][Confirmer|Annuler]")=1 Clr N&,P& Erase Mac$(),Maci$() Dim Mac$(Nmac&+2),Maci$(Nmac&+2) Macrd ~Objc_draw(Adr%(19),Ed_box&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) Endif Endif Case Ed_ld& ~Objc_draw(Adr%(19),A&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) Clr N&,P& ~@Form_wdo(19,-3) If Mac! And Len(A$)>0 File$=Set_path$+"SYSTEME\MACROS\"+A$+".SPM" Else File$=File$(1) If Len(Mpath$)>0 File$=Mpath$ If Not Mkeep! Clr Mpath$ Endif Endif File$=@Fsel$("",File$,"Charger macro") Endif If Len(File$)>0 If @Fexist(File$) File$(1)=File$ Gosub Defmouse(2) Fmshow("Chargement de la macro") If @Macload(File$) If Mac! A&=Ed_run& Fmhide Exit if True Endif Endif Fmhide Gosub Defmouse(0) Else ~@Form_alert(1,Errn33$) Endif Endif While Len(Mac$(P&))>0 Inc P& Wend N&=Max(0,P&-9) Gosub Macrd Clr A$ Case Ed_sv& If Mac! Gosub Defmouse(3) A!=True Else ~Objc_draw(Adr%(19),A&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) Clr N& ~@Form_wdo(19,-3) File$=@Fsel$(Set_path$+"SYSTEME\MACROS\*.SPM","","Sauver macro") If Len(File$)>0 Gosub Defmouse(2) Fmshow("Sauvegarde de la macro") Fileh&=@Fcreate(File$,0) If @Tsterr(Fileh&) Clr A$ A$="SWP3MACR"+Cr$ A&=0 While Len(Mac$(A&))>0 A$=A$+Mki$(Len(Mac$(A&)))+Mac$(A&) A$=A$+Mki$(Len(Maci$(A&)))+Maci$(A&) Inc A& Wend A$=A$+Cr$ ~@Tsterr(@Fwrite(Fileh&,A$)) Clr A$ ~@Tsterr(@Fclose(Fileh&)) Endif Fmhide Gosub Defmouse(0) Endif Gosub Macrd Clr A$ Endif Case Ed_add& ~Objc_draw(Adr%(19),A&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) ~@Form_wdo(19,-3) @W_rdexe ' ' Insert commande Do Gosub Macins If Len(Mac$(P&))>0 Inc P& Else Exit if True Endif Loop ' N&=Max(0,P&-9) Gosub Macrd Exdo!=True Case Ed_ann&,1 Exit if True Case Ed_run& Exit if True Case Ed_1& To Sub A&,Ed_1& ! ligne #a If A&<=9 If Len(Char{Ob_spec(Adr%(19),A&+Ed_1&)})>0 ~Graf_mkstate(X&,Y&,B&,B&) If Mac! If A! Gosub Defmouse(0) A!=False ' B&=0 If Nrac&>0 Repeat If Macf$(A&+N&)=Rac$(B&) Delete Rac$(B&) Delete Racb&(B&) Delete Racc&(B&) Dec Nrac& B&=-1 Exit if True Endif Inc B& Until B&=>Nrac& ! nrac-1 Endif ' If B&<>-1 ~@Form_wdo(19,-3) ~@Wind_update01(1) ~Objc_draw(Adr%(34),0,7,Rx&(34),Ry&(34),Rw&(34),Rh&(34)) @Videkbd ' B&=@Geminp(Evnt_keybd()) B&=Evnt_keybd() ! non r‚duit! C&=@Bios11 ~@Wind_update01(0) ~Form_dial(3,0,0,0,0,Rx&(34),Ry&(34),Rw&(34),Rh&(34)) Exdo!=True If B&<>27 A$=Trim$(Char{Ob_spec(Adr%(19),A&+Ed_1&)}) If Nrac&2 O&=Objc_find(Adr%(19),0,255,X&,Y&) Sub O&,Ed_1& If A&=O& L&=A& Add A&,Ed_1& ! ligne #a Ob_state(Adr%(19),A&)=Bset(Ob_state(Adr%(19),A&),0) ~Objc_draw(Adr%(19),Ed_box&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) Ob_state(Adr%(19),A&)=Bclr(Ob_state(Adr%(19),A&),0) Else ! d‚placer If O&=>0 And O&<=9 If Len(Char{Ob_spec(Adr%(19),O&+Ed_1&)})>0 A$=Mac$(A&+N&) Mac$(A&+N&)="" Insert Mac$(O&+N&)=A$ ' A$=Maci$(A&+N&) Maci$(A&+N&)="" Insert Maci$(O&+N&)=A$ ' A&=0 Repeat If Len(Mac$(A&))=0 Delete Mac$(A&) Delete Maci$(A&) Exit if True Endif ' Inc A& Until A&>P&+1 ' ' Recompter on sait jamais.. Clr P& While Len(Mac$(P&))>0 Inc P& Wend ' Else ! len=0 (last) ' Recompter on sait jamais.. Clr P& While Len(Mac$(P&))>0 Inc P& Wend ' Mac$(P&)=Mac$(A&+N&) Maci$(P&)=Maci$(A&+N&) Delete Mac$(A&+N&) Delete Maci$(A&+N&) ' Endif Macrd ~Objc_draw(Adr%(19),Ed_box&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) Endif Clr A$ Endif Endif Endif Endif Endif Default ~Objc_draw(Adr%(19),A&,7,Rx&(19),Ry&(19),Rw&(19),Rh&(19)) Endselect Loop ~@Form_wdo(19,-3) Gosub Defmouse(0) ' If B! If @Form_alert(1,"[2][Sauver raccourcis?][Confirmer|Annuler]")=1 Mac_svr Endif Endif ' ' Executer: If A&=Ed_run& @W_rdexe Gosub Macexe Endif ' Else If Form_alert(1,"[2][Voulez-vous interrompre le |macro en cours?][Confirmer|Annuler]")=1 Mexe!=False Endif Endif Return Function Macload(File$) $F% Local Adr% Local Fileh&,A& Local A! Local A$ ' Adr%=Fgetdta() ~Fsfirst(File$,0) Fileh&=@Fopen(File$,0) If @Tsterr(Fileh&) If Long{Adr%+26}<16000 A$=@Fread$(Fileh&,Long{Adr%+26}) ~@Tsterr(@Fclose(Fileh&)) ' If Len(A$)>0 If Left$(A$,10)="SWP3MACR"+Cr$ A$=Mid$(A$,11) Erase Mac$(),Maci$() Dim Mac$(Nmac&+2),Maci$(Nmac&+2) If Len(A$)>0 Clr A& While Len(A$)>0 And A&Eo_ann& Mac$(P&)=Char{Ob_spec(Adr%(20),A&)} Select A& Case Eo_op& ! op sp‚ciale Mac$(P&)="" Do Mac$(P&)=@Dinput$("Op‚ration,Valeur,Valeur..",Mac$(P&),B&) If B&=0 Or Len(Mac$(P&))=0 Maci$(P&)=Mki$(-1) ! ?? Mac$(P&)="" Exit if True Endif Maci$(P&)=@Macop$(Mac$(P&)) If Len(Maci$(P&))>0 Mac$(P&)="OP "+Mac$(P&) Exit if True Else @Beep Endif Loop ' Case Eo_sim& ! simulation touche ~Objc_draw(Adr%(34),0,7,Rx&(34),Ry&(34),Rw&(34),Rh&(34)) @Videkbd ~@Wind_update01(1) ' B&=@Geminp(Evnt_keybd()) B&=Evnt_keybd() ! pas r‚duit! C&=@Bios11 ~@Wind_update01(0) ~Form_dial(3,0,0,0,0,Rx&(34),Ry&(34),Rw&(34),Rh&(34)) ' If B&<>27 Maci$(P&)=Mki$(300)+Mki$(B&)+Mki$(C&) Mac$(P&)=Char{Ob_spec(Adr%(20),A&)}+" "+Chr$(B&)+",%"+Bin$(C&) Else Mac$(P&)="" Maci$(P&)=Mki$(-1) ! ?? Endif ' Case Eo_env& If Len(Char{{Ob_spec(Adr%(20),Eo_xenv&)}})>0 Maci$(P&)=Mki$(100)+Char{{Ob_spec(Adr%(20),Eo_xenv&)}} Mac$(P&)=Char{Ob_spec(Adr%(20),A&)}+Char{{Ob_spec(Adr%(20),Eo_xenv&)}} Else Mac$(P&)="" Maci$(P&)=Mki$(-1) ! ?? Endif Case Eo_com& If Len(Char{{Ob_spec(Adr%(20),Eo_xcom&)}})>0 Maci$(P&)=Mki$(101)+Char{{Ob_spec(Adr%(20),Eo_xcom&)}} Mac$(P&)=Char{Ob_spec(Adr%(20),A&)}+Char{{Ob_spec(Adr%(20),Eo_xcom&)}} Else Mac$(P&)="" Maci$(P&)=Mki$(-1) ! ?? Endif Case Eo_wait& Maci$(P&)=Mki$(102)+Mki$(Val(Char{{Ob_spec(Adr%(20),Eo_xwait&)}})) Mac$(P&)=Char{Ob_spec(Adr%(20),A&)}+Char{{Ob_spec(Adr%(20),Eo_xwait&)}} Case Eo_rec& Maci$(P&)=Mki$(103)+Char{{Ob_spec(Adr%(20),Eo_xrec&)}} Mac$(P&)=Char{Ob_spec(Adr%(20),A&)}+Char{{Ob_spec(Adr%(20),Eo_xrec&)}} Case Eo_ent& ' B&=Val(Char{{Ob_spec(Adr%(20),Eo_yent&)}}) B&=@State_pop(Adr%(20),Eo_yent&)-1 If B&=>0 And B&<=10 Maci$(P&)=Mki$(104)+Mki$(B&)+Char{{Ob_spec(Adr%(20),Eo_xent&)}} Mac$(P&)=Char{Ob_spec(Adr%(20),A&)}+Char{{Ob_spec(Adr%(20),Eo_xent&)}}+" #"+Str$(B&) Else ~@Form_alert(1,"[3][Erreur dans les paramŠtres!][Annuler]") Mac$(P&)="" Maci$(P&)=Mki$(-1) ! ?? Endif Case Eo_cnx& ! connect/deconnect If @State_pop(Adr%(20),Eo_dcn&)<>2 Maci$(P&)=Mki$(200) Mac$(P&)=Char{Ob_spec(Adr%(20),A&)}+" "+@Sent_pop$(Adr%(20),Eo_dcn&,1) Else Maci$(P&)=Mki$(201) Mac$(P&)=Char{Ob_spec(Adr%(20),A&)}+" "+@Sent_pop$(Adr%(20),Eo_dcn&,2) Endif ' Case Eo_dcn& Case Eo_f1& A&=@State_pop(Adr%(20),Eo_fct&)-1 A&=Min(9,Max(0,A&)) ' Sub A&,Eo_fct& If A&<=9 Maci$(P&)=Mki$(A&) ! instruction #a Mac$(P&)=@Sent_pop$(Adr%(20),Eo_fct&,A&+1) Else ~@Form_alert(1,"[3][Fonction inconnue!][Annuler]") Mac$(P&)="" Maci$(P&)=Mki$(-1) ! ?? Endif Default ~@Form_alert(1,"[3][Fonction inconnue!][Annuler]") Mac$(P&)="" Maci$(P&)=Mki$(-1) ! ?? Endselect If Maci$(P&)=Mki$(-1) ! ?? Mac$(P&)="" Maci$(P&)="" ' Else ' Inc P& Endif Endif Return ' Chaine OPT -> instruction Function Macop$(A$) Local A&,N& Local B$,E$ ' ex: Capture,1,1,40,24 ' A$=Trim$(A$) A$=A$+"," ' N&=Instr(A$," ") If N&>0 A&=Instr(A$,",") If N&0 If N&=0 B$=Upper$(B$) If Len(B$)<4 B$=B$+Space$(4-Len(B$)) Endif E$=E$+Left$(B$,4) ! instruction ' Inc N& Else ! paramŠtre B$=Upper$(B$) $S% Select Mid$(E$,5,4) Case "SAVE","LOAD","EXEC","EMUL" E$=E$+B$ Inc N& Exit if True Default If Val?(B$) E$=E$+Mki$(Val(B$)) Inc N& Else ' N&=-1 Exit if True Endif Endselect ' Endif Else N&=-1 Exit if True Endif Clr B$ Default B$=B$+Mid$(A$,A&,1) Endselect Inc A& Wend If N&>0 ! OK Mid$(E$,3,2)=Mki$(N&-1) $S% Select Mid$(E$,5,4) Case "COUP","TEXT","GRAP","SAVE","EXEC","EMUL" Return E$ Default Return "" Endselect $S& Endif ' Return "" Endfunc Procedure Macrd Local A&,B& Local A$,B$ ' L&=-1 If Mac! For A&=0 To 9 A$=Left$(Macf$(Min(Nmac&,N&+A&)),32) A$=A$+Space$(32-Len(A$)) For B&=0 To Nrac&-1 If Macf$(Min(Nmac&,N&+A&))=Rac$(B&) B$=@Rac$(B&) Mid$(A$,Len(A$)-Len(B$))=B$ Endif Next B& Char{Ob_spec(Adr%(19),Ed_1&+A&)}=Left$(A$,32) Next A& Else For A&=0 To 9 Char{Ob_spec(Adr%(19),Ed_1&+A&)}=Left$(Mac$(Min(Nmac&,N&+A&)),32) Next A& Endif Return ' Raccourci a Function Rac$(A&) Local A$ ' Clr A$ If Btst(Racc&(A&),0) A$=A$+Chr$(2) Endif If Btst(Racc&(A&),1) A$=A$+Chr$(1) Endif If Btst(Racc&(A&),2) A$=A$+"^" Endif If Btst(Racc&(A&),3) A$=A$+Chr$(7) Endif If Byte(Racb&(A&))=0 Select Shr(Racb&(A&),8) Case &H3B To &H44 A$=A$+"F"+Str$(Shr(Racb&(A&),8)-&H3B+$ And And And And Imp ÉÈœÞ[3][les textes minitel å$ And =< And Val#-Sin(Hex$(&H54 To &H5D Case &H54 To &H5D A$=A$+"F"+Str$(Shr(Racb&(A&),8)-&H54+1) Case &H62 A$=A$+"Hlp" Case &H61 A$=A$+"Und" Case &H48 A$=A$+"Haut" Case &H50 A$=A$+"Bas" Case &H4B A$=A$+"Gauc" Case &H4D A$=A$+"Droi" Case &H52 A$=A$+"Ins" Case &H47 A$=A$+"ClrH" Default A$=A$+"?" Endselect Else Select Racb&(A&) Case &H3920 A$=A$+"Spc" Case &H537F A$=A$+"Del" Case &H1C0A,&H1C0D A$=A$+"Ret" Case &H720D,&H720A A$=A$+"Ent" Default A$=A$+Chr$(@Geminp(Racb&(A&))) Endselect Endif Return A$ Endfunc Procedure Macexe Local A&,E& ' If (Not Mexe!) Menu.info("INTERROMPRE=F4") Gosub W_rdexe Mct%=0 Mexe!=True Clr Wexe$,Wexep& Clr A& While Len(Maci$(A&))>0 And Mexe! ~@Wind_update01(11) ~@Infow(4,Mac$(A&)) E&=@Macins(Maci$(A&)) Select E& Case 1 Inc A& Case 0 Case -4 ! brk Exit if True Default ~@Wind_update01(10) If @Form_alert(1,"[3][Instruction inconnue|#"+Str$(-E&)+"][Continuer|Annuler]")=2 Exit if True Else ~@Wind_update01(11) Endif Inc A& Endselect ' **~@Wind_update01(10) ' ' Gosub Process ! gestion bouclage GEM *NON* Exit if Set_end! ' Wend Mexe!=False Clr Mfloor& If Not Set_end! ~@Infow(4,"FIN DE LA MACRO-COMMANDE") ' ~@Form_alert(1,"[1][Fin du macro][Confirmer]")=1 Endif ~@Wind_update01(10) ' Else If @Form_alert(1,"[2][Voulez-vous interrompre le |macro en cours?][Confirmer|Annuler]")=1 Mexe!=False Endif Endif Return Procedure Mac_svr Local A& ' ~@Wind_update01(1) Fmshow("Sauvegarde des raccourcis macros") A$="; Fichier des raccourcis macros"+Mki$(&HD0A) For A&=0 To Nrac&-1 A$=A$+Rac$(A&)+Mki$(&HD0A) A$=A$+Hex$(Racb&(A&))+Mki$(&HD0A) A$=A$+Hex$(Racc&(A&))+Mki$(&HD0A) Next A& A$=A$+Mki$(&HD0A) ' Fileh&=@Fcreate(Set_path$+"SYSTEME\"+"MACROS.SET",0) If @Tsterr(Fileh&) ~@Tsterr(@Fwrite(Fileh&,A$)) ~@Tsterr(@Fclose(Fileh&)) Endif Fmhide ~@Wind_update01(0) ' Return ' Load macros.set Procedure Macinit(E$) Local N& Local A$ ' ' Raccourcis If Dim?(Rac$()) Erase Rac$(),Racb&(),Racc&() Endif Maxrac&=99 Nrac&=0 Dim Rac$(Maxrac&+2),Racb&(Maxrac&+2),Racc&(Maxrac&+2) A$=@Flin$(E$) Clr N& While Len(A$)>0 And N&0 A&=Cvi(Left$(A$,2)) ! instruction If Len(A$)>2 B&=Cvi(Mid$(A$,3,2)) ! param ‚ventuel If Len(A$)>4 C&=Cvi(Mid$(A$,5,2)) ! param ‚ventuel Endif Endif Select A& Case 0 ! somm ~@Emulek(199,0,0,0) Return 1 Case 1 ! ann ~@Emulek(225,0,0,0) Return 1 Case 2 ! ret ~@Emulek(200,0,0,0) Return 1 Case 3 ! r‚p ~@Emulek(27,0,0,0) Return 1 Case 4 ! guid ~@Emulek(226,0,0,0) Return 1 Case 5 ! corr ~@Emulek(8,0,0,0) Return 1 Case 6 ! suit ~@Emulek(208,0,0,0) Return 1 Case 7 ! env ~@Emulek(13,0,0,0) Return 1 Case 8 ! cnxf ~@Emulek(3,0,0,0) Return 1 Case 9 ! dcnx ~@Wind_update01(0) Gosub Modcut Return 1 ' Case 100 Mact(2,A$) Outvid(Mid$(A$,3)) Return 1 Case 101 Mact(2,A$) Dial(Mid$(A$,3)) Return 1 Case 102 If Mct%=0 Mct%=Gemdos(44) Else ~@Wind_update01(0) Gosub Proc_time(500) ! process-gem If @Timsec(Gemdos(44))-@Timsec(Mct%)=>B& ! ok time Clr Mct% Return 1 Endif Endif Return 0 Case 103 ' ~@Infow(4,"Wait: "+Mid$(A$,3)) Mact(2,A$) If Wexe! ~@Wind_update01(0) Gosub Proc_time(250) ! process-gem If Wexep&=0 ! ok trouve (recu) Wexe!=False Clr Wexe$,Wexep& Return 1 Endif Else Wexe!=True Wexe$=Mid$(A$,3) Wexep&=1 Endif Return 0 Case 104 ~@Wind_update01(0) Mact(4,A$) Mastr$(B&)=@Dinput$(Left$(Mid$(A$,5),30),"",X&) If X& Return 1 Else Return -4 Endif Case 200 ~@Wind_update01(0) Gosub Proc_time(250) ! process-gem If Connect! Return 1 Else Return 0 Endif Case 201 ~@Wind_update01(0) Gosub Proc_time(250) ! process-gem If Connect! Return 0 Else Return 1 Endif ' Case 300 ! simulation clavier ' Version "r‚duite" ou non mais accept‚e par msg_bra Msg_bra(&X1,0,B&,0,0,0,0,C&) Return 1 ' Case 400 ' FNCT NPAR OP OP par1 par2 par3 .. ' A&=Cvi(Mid$(A$,9,2)) B&=Cvi(Mid$(A$,11,2)) C&=Cvi(Mid$(A$,13,2)) D&=Cvi(Mid$(A$,15,2)) E&=Cvi(Mid$(A$,17,2)) ' $S% Select Mid$(A$,5,4) Case "COUP" If A&=>1 And B&=>0 And A&-1+C&<=Vmax_x&+1 And B&+D&<=Vmax_y&+1 @Copblk(@Miniblock$(A&-1,B&,C&,D&)) Return 1 Else ~@Form_alert(1,"[3][ParamŠtres Couper erron‚s][Annuler]") Return -6 Endif Case "TEXT" If A&=>1 And B&=>0 And A&-1+C&<=Vmax_x&+1 And B&+D&<=Vmax_y&+1 @Copblk(@Minitext$(A&-1,B&,C&,D&)) Return 1 Else ~@Form_alert(1,"[3][ParamŠtres TextCouper erron‚s][Annuler]") Return -6 Endif Case "GRAP" If A&=>1 And B&=>0 And A&-1+C&<=Vmax_x&+1 And B&+D&<=Vmax_y&+1 @Emtransf(False,A&-1,B&,C&,D&) Return 1 Else ~@Form_alert(1,"[3][ParamŠtres GraphCouper erron‚s][Annuler]") Return -6 Endif Case "SAVE" File$(2)="*"+Mid$(A$,9) @Save.vdt(0) ' Return 1 Case "LOAD" File$(2)=Mid$(A$,9) @Load.vdt(1) ' Return 1 Case "EXEC" @Prgl(Mid$(A$,9),"") ' Return 1 Case "EMUL" @Vprint(Mid$(A$,9)) ' Return 1 Default ~@Form_alert(1,"[3][Op‚ration inconnue][Annuler]") Return -5 Endselect $S& ' @Copblk(@Miniblock$(Mx&,My&,Mx2&,My2&)) ' Default Return -Abs(A&) Endselect Endif Return -1 Endfunc Procedure Mact(L&,Var A$) Local A& Local B$,C$ C$=Mid$(A$,L&+1) Clr B$ A&=1 Repeat If Mid$(C$,A&,1)="#" If @Tstn(Mid$(C$,A&+1,1)) B$=B$+Mastr$(Asc(Mid$(C$,A&+1,1))-48) Inc A& Else B$=B$+Mid$(C$,A&,1) Endif Else B$=B$+Mid$(C$,A&,1) Endif Inc A& Until A&>Len(C$) ' A$=Left$(A$,L&)+B$ Return ' ' ' ' Procedure Flash Local T%,A! ' If @Firstw<>-1 ! 1 fenˆtre en 1e plan? If Recept! ! mode r‚ception? A!=@Wtestop(4) ! ‚mul en 1e plan? If Not A! A!=@W_tstview(4) ! mais voit-on la fenˆtre totalement? If Not A! A!=Gemactive! ! si GemActive=True alors forcer (mˆme si risque de bugs d'affichage!) Endif Endif ' If A! ' T%=Gemdos(44) ' If @Timsec(T%)-@Timsec(Flt%)=>2 T%=Timer If T%-Flt%=>100 ! 0.5 Hz Flt%=T% Fls!=Not Fls! ' @Hidem Gosub Clign(Fls!) ! clignotement! ' @Showm Endif Endif ' If A! Sw_clip If Ncurs! @Drcurs(Not Vcr!) Endif ' Clip_off Gosub Tmanage(True) ! tester ‚mulateur Else If Ncurs! Part_draw(-(Not Vcr!)) Endif ' Clip_off Gosub Tmanage(False) ! tester ‚mulateur Endif Endif ' Endif ' Return ' $P< Procedure Clign(Flag!) ' Local A! ' A!=True ' If Not Rafale! Gosub Vid_rst(True) Endif ' ' ~@Wind_update01(0) Cl_n&=0 For Cl_b&=0 To Vmax_y& For Cl_a&=0 To Vmax_x& If Btst(Vida|(Cl_a&,Cl_b&),0) ! clignote? If Vidp|(Cl_a&,Cl_b&)=0 ! non photographique If Vids&(Cl_a&,Cl_b&)<>32 ! pas la peine! If Btst(Vida|(Cl_a&,Cl_b&),3)<>Flag! ! cacher clignotement ou non clignotement Vidrdc&(Cl_n&)=Vids&(Cl_a&,Cl_b&) Vidrdx&(Cl_n&)=Cl_a& Vidrdy&(Cl_n&)=Cl_b& Inc Cl_n& Vids&(Cl_a&,Cl_b&)=32 ' Vdraw(Cl_a&,Cl_b&) ' Vids&(Cl_a&,Cl_b&)=Cl_s& ' Else ' Vdraw(Cl_a&,Cl_b&) Endif Vidrd|(Cl_a&,Cl_b&)=&HFF ! redraw quand mˆme Endif Endif Endif Next Cl_a& Next Cl_b& ' Gosub Vrefresh ! redraw ' ' Re-‚crire.. For Cl_a&=0 To Cl_n&-1 Vids&(Vidrdx&(Cl_a&),Vidrdy&(Cl_a&))=Vidrdc&(Cl_a&) Next Cl_a& Return $P> ' ' Procedure Semc(E$,A$) If Mk&<>0 If E$="#" ~@Emulek(444,0,True,0) Else if E$="##" Else ~@Infow(4,E$) If Len(A$)>0 Outvid(A$) Endif Endif Else If Len(E$)>0 If Left$(E$,1)="'" Emcl$="®"+E$+"¯" Else if E$="#" Emcl$="Connect‚? (clic=d‚finir)" Else if E$="##" Emcl$="clic: modifier taille ‚mulateur" Else Emcl$="["+E$+"]" If Not Clipinfo! If Set_mouse&<>3 Gosub Defmouse(3) Endif Endif Endif Else Clr Emcl$ If Not Clipinfo! If Set_mouse&<>0 Gosub Defmouse(0) Endif Endif Endif ~@Infow(4,"") Endif Return Procedure Emclic(Mx&,My&,Mk&) Local E$,C$ Local X&,C& Local A&,B& ' If Mx&=0 And My&=0 And Mk&=0 Semc("","") Else If Mk&<>0 Gosub Defmouse(3) @Sw_clip Endif 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) ! <>graph ' If My&=0 And Mx&=F_c& E$="#" Else if My&=>Vmax_y& And Mx&=>Vmax_x& E$="##" Else ' Clr A&,B& If Btst(Vids&(Mx&,My&),8+$ And And And And Eqv And ) ! 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 Endif ' If E$<>" " ' If E$<>"#" X&=Mx&-1 While X&=>0 Exit if Btst(Vida|(X&,My&),4) ! 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 Endif ' If E$<>" " If Mk&<>0 Graphmode 3 @Hidem 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) @Showm Delay 0.1 @Hidem 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) @Showm Graphmode 1 Endif ' C$=Upper$(E$) If C$="SOMMAIRE" Or C$="SOMM" Or C$="SOMM." Semc("Sommaire",Sep$+"F") Else if C$="GUIDE" Semc("Guide",Sep$+"D") Else if C$="SUITE" Semc("Suite",Sep$+"H") Else if C$="RETOUR" Or C$="RET." Semc("Retour",Sep$+"B") Else if C$="ANNULATION" Or C$="ANNUL" Or C$="ANNUL." Semc("Annulation",Sep$+"E") Else if C$="CX/FIN" Or C$="CONNEXION/FIN" Or C$="CONNEXION" Or C$="CNX/FIN" Semc("Connexion/Fin",Sep$+"I") Else if C$="REPETITION" Or C$="RPTITION" Semc("R‚p‚tition",Sep$+"C") Else if C$="ENVOI" Semc("Envoi",Sep$+"A") Else if C$="CORRECTION" Or C$="CORREC" Or C$="CORREC." Semc("Correction",Sep$+"G") Else if C$="#" Semc("#","") Else if C$="##" Semc("##","") ' Else If Len(E$)<=20 Semc("'"+E$+"'",E$+Sep$+"A") Else If Mk&<>0 ~@Infow(4, With Trace$Round() As Trace$Cfloat(Deg((() Else Semc("","") Endif Endif ' Endif Else If Mk&<>0 ~@Infow(4,"?") Else Semc("","") Endif Endif Else If Mk&<>0 ~@Infow(4,"?") Else Semc("","") Endif Endif Else If Mk&<>0 ~@Infow(4,"?") Else Semc("","") Endif Endif If Mk&<>0 Gosub Defmouse(0) Endif Endif Endif ' Return Procedure Clclic(Mx&,My&,Mk&) Local O&,X&,Y&,W&,H& Local N& ' Ob_x(Adr%(36),0)=@Wxacoord(4,0) Ob_y(Adr%(36),0)=@Wyacoord(4,(Vmax_y&+1)*Eccsizey&+Emy&+4) ' O&=Objc_find(Adr%(36),0,7,Mx&,My&) If O&=>Dk_cf& And O&<=Dk_sto& ' If O&<=Dk_en& ~Objc_offset(Adr%(36),O&,X&,Y&) W&=Ob_w(Adr%(36),O&) H&=Ob_h(Adr%(36),O&) Ob_state(Adr%(36),O&)=Bset(Ob_state(Adr%(36),O&),0) ~Form_dial(3,0,0,0,0,X&-2,Y&-2,W&+4,H&+4) Gosub W_rdexe Else Mgr(O&,True) Endif ' Select O& Case Dk_cf& ! cnxf N&=3 Case Dk_so& ! somm N&=199 Case Dk_an& ! annul N&=225 Case Dk_re& ! ret N&=200 Case Dk_rp& ! rep N&=27 Case Dk_ap& ! APPEL If Not Connect! N&=192 Endif Case Dk_gu& ! guide N&=226 Case Dk_co& ! corr N&=8 Case Dk_su& ! suite N&=208 Case Dk_en& ! envoi N&=13 ' Case Dk_rec& N&=-1 Case Dk_arr& N&=-2 Case Dk_ava& N&=-3 Case Dk_pla& N&=-4 Case Dk_pau& N&=-5 Case Dk_sto& N&=-6 ' Case Dk_cl& Gosub Set_deskc(Not Desk_c!) Gosub Nice4 ' Default Clr N& Endselect ' If N&>0 ~@Emulek(N&,0,False,0) Gosub W_rdexe Gosub Caremouse Ob_state(Adr%(36),O&)=Bclr(Ob_state(Adr%(36),O&),0) ~Form_dial(3,0,0,0,0,X&-2,Y&-2,W&+4,H&+4) Else if N&<0 Gosub Magn(-N&) Else Ob_state(Adr%(36),O&)=Bclr(Ob_state(Adr%(36),O&),0) ~Form_dial(3,0,0,0,0,X&-2,Y&-2,W&+4,H&+4) Endif ' Endif ' Return Procedure Clic_eml(Mx&,My&,Mk&,A&) Local X&,Y&,B&,X2&,Y2&,O& ' O&=Objc_find(Adr%(36),0,7,Mx&,My&) ' ' Sizer.. If Desk_c!=False If Not (My&<=@Wyacoord(4,Emy&+(Vmax_y&+1)*Eccsizey&) And (My&<=@Wyacoord(4,Emy&+(Vmax_y&)*Eccsizey&) Or Mx&<=@Wxacoord(4,Emx&+(Vmax_x&)*Eccsizex&))) O&=Dk_cl& Endif Endif ' If O&<=0 If My&<=@Wyacoord(4,Emy&+(Vmax_y&+1)*Eccsizey&) And (My&<=@Wyacoord(4,Emy&+(Vmax_y&)*Eccsizey&) Or Mx&<=@Wxacoord(4,Emx&+(Vmax_x&)*Eccsizex&)) If (A&=&X1 Or A&=&X10) 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),@Wxacoord(4,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) Rd_all(4,W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4)) Endif ' Else if A&=&X1000 ~Graf_mkstate(B&,B&,B&,A&) ' If (@Wxrcoord(4,Mx&)-Emx&)\Eccsizex&=>Vmax_x&-1 And (@Wyrcoord(4,My&)-Emy&)\Eccsizey&=>Vmax_y&-1 And And(A&,&X11)<>0 Gosub Clip_off ' ' If (@Wxrcoord(4,Mx&)-Emx&)\Eccsizex&=>Vmax_x& And (@Wyrcoord(4,My&)-Emy&)\Eccsizey&=>Vmax_y& ' Else Gosub Emclip(Mx&,My&) ' Gosub Infreg ' Endif Else if A&=&X100 Clr A&,B& ' Gosub Defmouse(7) Mx&=@Wxacoord(4,((@Wxrcoord(4,Mx&)-Emx&)\Eccsizex&)*Eccsizex&+Emx&) My&=@Wyacoord(4,((@Wyrcoord(4,My&)-Emy&)\Eccsizey&)*Eccsizey&+Emy&) ' ~Graf_rubberbox(Mx&,My&,1,1,A&,B&) If @X_rubberbox(Eccsizex&,Eccsizey&,Mx&,My&,1,1,A&,B&)=0 If A&<0 A&=-A& Mx&=Mx&-A& Endif If B&<0 B&=-B& My&=My&-B& Endif If A&=>4 And B&=>4 And @Mousek=0 ' If Mod(A&,Eccsizex&)<>0 A&=Min((Vmax_x&+1)*Eccsizex&-((@Wxrcoord(4,Mx&)-Emx&)\Eccsizex&)*Eccsizex&,(A&\Eccsizex&)*Eccsizex&) ' Endif ' If Mod(B&,Eccsizey&)<>0 B&=Min((Vmax_y&+1)*Eccsizey&-((@Wyrcoord(4,My&)-Emy&)\Eccsizey&)*Eccsizey&,(B&\Eccsizey&)*Eccsizey&) ' Endif Gosub Defmouse(0) Gosub Emtransf(False,Mx&,My&,A&,B&) ' Gosub Infreg Else Gosub Defmouse(0) Endif Endif Else Gosub Emclic(Mx&,My&,Mk&) Endif Endif ' ' ' Else If Nice! ' ' ' ~Objc_offset(Adr%(36),Dk_cl&,X&,Y&) ' ' If (Mx&=>X& And My&=>Y& And Desk_c!) Or ((Not Desk_c!) And (Not (My&<=@Wyacoord(4,Emy&+(Vmax_y&)*Eccsizey&) Or Mx&<=@Wxacoord(4,Emx&+(Vmax_x&)*Eccsizex&)))) If Desk_c! And (O&=Dk_cl&) Gosub Free_num(Mx&,My&,Mk&) Else if (Desk_c! And (O&=Dk_sz&)) Or (Not Desk_c!) ' ~Graf_rubberbox(W_ex&(4),W_ey&(4),(Vmax_x&+1)*2,(Vmax_y&+1)*2,A&,B&) @Lhidem @Clip_off Graphmode 3 Contrl(0)=113 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=&X1010101010101010 Vdisys Defline 7 Box W_ix&(4),W_iy&(4),W_ix&(4)+X2&-1,W_iy&(4)+Y2&-1 @Lshowm X&=(W_ix&(4)+W_iw&(4)-1)-Mx&+1 Y&=(W_iy&(4)+W_ih&(4)-1)-My&+1 Gosub Emclic(0,0,0) ~@Infow(4,"Taille: "+Str$((Vmax_x&+1)*Eccsizex&)+" X "+Str$((Vmax_y&+1)*Eccsizey&)+"(100%: "+Str$((Vmax_x&+1)*8)+"X"+Str$((Vmax_y&+1)*10)+")") Do ~Graf_mkstate(A&,B&,Mk&,C&) A&=Min(W_desk&-2,A&-W_ix&(4)+X&) B&=Min(H_desk&-2,B&-W_iy&(4)+Y&) ' Sub A&,Emx&+4 Sub B&,Emy&+Emy2&+4 A&=(A&\(Vmax_x&+1))*(Vmax_x&+1) B&=(B&\(Vmax_y&+1))*(Vmax_y&+1) A&=Max((Vmax_x&+1)*2,A&) B&=Max((Vmax_y&+1)*2,B&) Add A&,Emx&+4 Add B&,Emy&+Emy2&+4 ' ' A&=((A&+1)\(Vmax_x&+1))*(Vmax_x&+1) ' B&=((B&+1)\(Vmax_y&+1))*(Vmax_y&+1) If A&<>X2& Or B&<>Y2& ~@Infow(4,"Taille: "+Str$(A&-(Emx&+4))+" X "+Str$(B&-(Emy&+Emy2&+4))+" (100%: "+Str$((Vmax_x&+1)*8)+"X"+Str$((Vmax_y&+1)*10)+")") @Lhidem Box W_ix&(4)+Emx&,W_iy&(4)+Emy&,W_ix&(4)+Emx&+X2&-1,W_iy&(4)+Emy&+Y2&-1 X2&=A& Y2&=B& Box W_ix&(4)+Emx&,W_iy&(4)+Emy&,W_ix&(4)+Emx&+A&-1,W_iy&(4)+Emy&+B&-1 @Lshowm Endif Loop until Mk&<>1 @Lhidem Box W_ix&(4)+Emx&,W_iy&(4)+Emy&,W_ix&(4)+Emx&+A&-1,W_iy&(4)+Emy&+B&-1 Defline 1 Graphmode 1 @Lshowm ' If Mk&=0 If A&<>(Vmax_x&+1)*Eccsizex&+Emx&+4 Or B&<>(Vmax_y&+1)*Eccsizey&+Emy&+Emy2&+4 Gosub Defmouse(2) Gosub Nice_size(A&,B&) Gosub Defmouse(0) Endif Endif Gosub Caremouse ' Else Gosub Clclic(Mx&,My&,Mk&) Endif Endif Endif ' Return Procedure Set_deskc(Flag!) If Desk_c!<>Flag! Desk_c!=Flag! ' Taille clavier en bas If Desk_c! Emy2&=Ob_h(Adr%(36),0) Else Emy2&=0 Endif Endif Return Procedure Emclip(Mx&,My&) Local X&,Y&,P&,Mx2&,My2&,A&,S&,X2&,Y2& Local Z& Local P$,File$ Local A! Local Chk& ' Keepbin(True) ! 'sauver' buffer! If @Tstblk ' X2&=X_curs& Y2&=Y_curs& ' Gosub Defmouse(1) @Drcurs(False) Sw_clip ! clipping fenˆtre ' ~@Infow(4,"Couper.. [SHIFT] : garder 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& ~@Graf_mkstate(Mx2&,My2&,P&,Z&) Pbox Mx&,My&,Mx2&,My2& Graphmode (1) @Showm Repeat ' Mouse X&,Y&,P& ~@Graf_mkstate(X&,Y&,P&,Z&) 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) Pbox Mx&,My&,Mx2&,My2& Pbox Mx&,My&,X&,Y& Graphmode (1) @Lshowm ' Mx2&=X& My2&=Y& Endif Until P&<>1 @Lhidem Graphmode (3) 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 And Len(Register$)>0 ' A!=Not ((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$ File$=Scrap$ ' If Len(File$)>0 ' A&=@Form_alert(1,"[3][Couper bloc.. ][Texte|Vid‚otex|Annuler]") ' ' Protection Chk&=Plans&*10 Plans&=1 ' ~@Infow(4,"Coller..") Gosub Defmouse(2) ' binair$="" Clearbin ' '@minitext$ @Copblk(@Minitext$(Mx&,My&,Mx2&,My2&)) ' ' Protection Plans&=Chk&\10+(Not @Check2) ! pirate! ' Gosub Defmouse(2) ' open "O",#1,File$+"SCRAP.TXT" Fileh&=@Fcreate(File$+"SCRAP.TXT",0) If @Tsterr(Fileh&) ' print #1,binair$; ' ~@Tsterr(@Fwrite(Fileh&,binair$)) ~@Tsterr(@Fadrwrite(Fileh&,Binair%,Binp%)) ~@Tsterr(@Fclose(Fileh&)) ' close #1 Endif ' ' Fichier "ajout" If @Exist(File$+"SCRAP.1ST") ' open "U",#1,File$+"SCRAP.1ST" Fileh&=@Fopen(File$+"SCRAP.1ST",2) If Fileh&=>0 ' seek #1,Lof(#1) ~@Fendseek(Fileh&,0) Endif Else ' open "O",#1,File$+"SCRAP.1ST" Fileh&=@Fcreate(File$+"SCRAP.1ST",0) Endif ' If @Tsterr(Fileh&) ' print #1,Cr$; ' print #1,binair$; ' ~@Tsterr(@Fwrite(Fileh&,Cr$+binair$)) ~@Tsterr(@Fwrite(Fileh&,Cr$)) ~@Tsterr(@Fadrwrite(Fileh&,Binair%,Binp%)) ' ~@Tsterr(@Fclose(Fileh&)) ' ' R‚afficher clipbrd! Gosub Clp_lire(-1) ' close #1 Endif ' ' Format VDT: ' binair$=@Miniblock$(Mx&,My&,Mx2&,My2&) Clr Binp% @Copblk(@Miniblock$(Mx&,My&,Mx2&,My2&)) ' Fileh&=@Fcreate(File$+"SCRAP.VDT",0) If @Tsterr(Fileh&) ' ~@Tsterr(@Fwrite(Fileh&,binair$)) ~@Tsterr(@Fadrwrite(Fileh&,Binair%,Binp%)) ~@Tsterr(@Fclose(Fileh&)) Endif ' ' binair$="" ' ''actb&=S& ' actb&=0 ! Bloc 0 par d‚faut Gosub Defmouse(0) ' ~@Infow(4,"Buffer sauv‚ SCRAP.TXT SCRAP.1ST SCRAP.VDT") ' Else Gosub Drawx(4) Endif Else Gosub Drawx(4) Endif ' X_curs&=X2& Y_curs&=Y2& @Drcurs(True) @Caremouse Gosub Defmouse(0) ' Endif Keepbin(False) ! 'sauver' buffer! ' Return Procedure Emtransf(Flag!,X&,Y&,W&,H&) Local Adr%,L% Local W2& Local Z&,N&,A$ ' ~@Wind_update01(1) Gosub Defmouse(2) ' ' If Mod(W&,16)<>0 ' W2&=(W&\16+1)*16 ' Else ' W2&=W& ' Endif W2&=((W&+15)\16)*16 ' L%=(W2&*H&*Plans&)\8 Adr%=@Malloc(L%) If Adr%>0 If Y&+H&<=H_gdesk% And W&>0 And H&>0 If Len(Register$)>0 ' @Lhidem G_s%(0)=Adr% ! placer adresse G_s%(1)=W& G_s%(2)=H& ' If Mod(W&,16)=0 ' G_s%(3)=W&\16 ' Else ' G_s%(3)=W&\16+1 ' Endif G_s%(3)=(W&+15)\16 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 ' Bitblt G_screen%(),G_s%(),R_d%() ! Vdi Raster Copy ; Opaque ' ' ' Protection If Not @Check2 ! pirate! ' Plans&=Plans&+1 ! re-gnagnagna Delete Adr%(0) ! Yeahh!! Endif ' Graphmode 3 Pbox X&,Y&,X&+W&-1,Y&+H&-1 Graphmode 1 ' @Lshowm Gosub Defmouse(0) If Flag! File$=File$(4) Else File$=@Fsel$("\*.BLK",File$(4),"Sauver image") Endif If Len(File$)>0 File$(4)=File$ Gosub Defmouse(2) Fmshow("Sauvegarde de l'image") Fileh&=@Fcreate(File$,0) If @Tsterr(Fileh&) ' open "o",#1,File$ ' print #1,Mki$(W&-1)+Mki$(H&-1)+Mki$(Plans&); ' Bput #1,Adr%,L% ' close #1 If @Tsterr(@Fwrite(Fileh&,Mki$(W&-1)+Mki$(H&-1)+Mki$(Plans&))) If @Tsterr(@Fadrwrite(Fileh&,Adr%,L%)) ' Palette N&=@Ncol(Plans&) If N&>0 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 A$=A$+Mki$(Intout(1))+Mki$(Intout(2))+Mki$(Intout(3)) Next Z& ~@Tsterr(@Fwrite(Fileh&,A$)) Endif ~@Tsterr(@Fclose(Fileh&)) Endif Endif Endif Fmhide Endif @Lhidem Graphmode 3 Pbox X&,Y&,X&+W&-1,Y&+H&-1 Graphmode 1 @Lshowm ' Gosub Defmouse(0) Endif ' Else ~@Form_alert(1,"[1][Erreur lors de la copie][ Annuler ]") Endif ~@Mfree(Adr%) Else ~@Form_alert(1,"[1][Pas assez de m‚moire |pour copier][ Annuler ]") Endif @Caremouse ' Gosub Defmouse(0) ~@Wind_update01(0) Return Procedure Adrcut Local A&,N&,S&,L& Local A! Local Fileh& Local A$,E$,File$ ' If Len(Register$)>0 File$=Scrap$ ~@Infow(4,"Coller adresse dans "+File$+"SCRAP.DAT") Clr A$ S&=4 N&=S& L&=1 A!=False Do Clr E$ E$=Trim$(@Minitext$(0,N&,Vmax_x&+1,1)) A&=Instr(E$,"_") While A&>0 E$=Left$(E$,A&-1)+" "+Mid$(E$,A&+1) A&=Instr(E$,"_") Wend E$=Trim$(E$) If E$=Cr$ Clr E$ Else if Left$(E$,1)="`" Clr E$ Endif ' ' TrucMuche: ' ' AdresseS ' ' Trucmuche: ' Adresse ' If Len(E$)>0 Or (L&=2 And (Not A!)) If Len(E$)>0 Clr A! If L&=1 ! ligne No If Mid$(E$,2,1)=" " Or Mid$(E$,3,1)=" " ! 1 Mr Truc E$=Trim$(Mid$(E$,3)) Endif A&=Rinstr(E$," ") If A&>0 ! Nø + .. A$=A$+Trim$(Left$(E$,A&))+Cr$ A$=A$+Trim$(Mid$(E$,A&)) Else A$=A$+E$ Endif Else A$=A$+E$ Endif If Right$(A$,2)<>Cr$ A$=A$+Cr$ Endif Inc L& Else L&=1 ! prendre adresses s‚par‚es A!=True ! peut ˆtre 1 seule ligne??? Endif Else If Not A! ! s‚parateur? A!=True L&=1 If Right$(A$,4)<>Cr$+Cr$ A$=A$+Cr$ Endif Else ! 2 lignes vides! Exit if True Endif Endif Inc N& Loop until N&=>Vmax_y& ' ' Fichier "ajout" If @Exist(File$+"SCRAP.DAT") Fileh&=@Fopen(File$+"SCRAP.DAT",2) If Fileh&=>0 ~@Fendseek(Fileh&,0) Endif Else Fileh&=@Fcreate(File$+"SCRAP.DAT",0) Endif ' If @Tsterr(Fileh&) ~@Tsterr(@Fwrite(Fileh&,A$)) ~@Tsterr(@Fclose(Fileh&)) Endif Endif Return ' ' Procedure Rim_init Local Adr% Local A$ Local A! ' Adr%=Fgetdta() If Rim%>0 ~@Mfree(Rim%) Endif ' If Len(Nom_rim$)=0 Nom_rim$="JPEG.RIM" Endif If Len(Nom_trm$)=0 Nom_trm$="PARX.TRM" Endif ' A!=False If Len(Parx$)=0 A!=True Else If Fsfirst(Parx$+"PARX.TRM",&H0)<>0 ! Non trouv‚! A!=True Endif Endif ' If A! ! Non trouv‚! Parx$=Chr$(65+Drive&)+":\PARX.SYS\" If Fsfirst(Left$(Parx$,Max(0,Len(Parx$)-1)),&H10)=-33 If Fsfirst("C:\PARX.SYS",&H10)=0 Parx$="C:\PARX.SYS\" Else if Fsfirst(Chr$(65+Drive&)+":\PARX.SYS",&H10)=0 Parx$=Chr$(65+Drive&)+":\PARX.SYS\" Else if Fsfirst(Set_path$+"PARX.SYS",&H10)=0 Parx$=Set_path$+"PARX.SYS\" ' Else Parx$="C:\PARX.SYS\" Endif ' If Fsfirst(Parx$+"PARX.TRM",&H0)=0 ' If @Form_alert(1,"[2][Chemin PARX.SYS reconfigur‚..|Sauver chemin?][Confirmer|Annuler]")=1 @Sv.parx ' Endif Else If Fsfirst(Left$(Parx$,Max(0,Len(Parx$)-1)),&H10)=0 ! POURTANT EXISTE! ~@Form_alert(1,"[2][Chemin PARX.SYS trouv‚..|mais pas de PARX.TRM?!][Re-essayer]") Endif Gosub Parx_def Endif ' Endif Else If Right$(Parx$,1)<>"\" Parx$=Parx$+"\" Endif Endif ' Gosub Defmouse(2) If Fsfirst(Left$(Parx$,Max(0,Len(Parx$)-1)),&H10)=0 ' ' ''''' File$=Parx$+"RIM\JPEG.RIM"+Chr$(0) ' ' File$=Parx$+"RIM\JPEG.RIM"+Chr$(0) ' File$=Parx$+"RIM\"+Nom_rim$+Chr$(0) Ext$=".JPG" If @Rim_rd<>-1 Nom_rim$="JPEG_68K.RIM" If @Rim_rd=0 Nom_rim$="JPEGDEMO.RIM" If @Rim_rd=0 Nom_rim$="JPEG.RIM" If @Rim_rd=0 Nom_rim$="JPG_68K.RIM" If @Rim_rd=0 Nom_rim$="JPG_DSP.RIM" If @Rim_rd=0 Nom_rim$="JPG.RIM" If @Rim_rd=0 ~@Form_alert(1,"[3][Fichier RIM non trouv‚!][Annuler]") Endif Endif Endif Endif Endif Endif Endif ' Read_trm ' ' Init If Trm%>0 R%=Trm%+&H7A6+2 ~C:R%(2,W:(-Px_card!),L:0,L:0,L:0,L:0,L:0,W:0) Endif ' If Rim%<=0 Or Trm%<=0 ~@Form_error(1, heuresement|pas ‚t‚ perduf$fèèef8/¼fÌ àÍæÉÿÿÿûfe xmove hÌ | )Double{\= With With Mkf$(Min( With )Char{Min()Mkl$(Rad(Char{ With Deg(Mkf$( Offset Mkf$(Cfloat(Bin$()Acos( Downto #Trunc(Rnd(Acos(#,:PiRound(Bin$(Cvs(Trace$Cfloat(Bin$(Atn()Round(Rad(Trace$Bin$(Trace$Atn()Bin$( With Char{ Offset Char{Deg(Mkf$(Double{\Asin(Cfloat(Cfloat(Min( As Mkf$( With Double{) Endif Else ~@Form_alert(1,"[3][Sans PARX.SYS la gestion |photo est impossible!][Annuler]") Rim%=-1 Trm%=-1 Endif Gosub Defmouse(0) ' Return Procedure Parx_def Local F$ Local A& ' F$=@Fsel$(Parx$,"*.*","DOSSIER 'PARX.SYS' ?") If Len(F$)=0 If Len(Parx$)=0 Or Fsfirst(Left$(Parx$,Max(0,Len(Parx$)-1)),&H10)=-33 Parx$=Chr$(65+Drive&)+":\PARX.SYS\" Endif Else Parx$=F$ If Right$(Parx$,1)<>"\" Parx$=Left$(Parx$,Rinstr(Parx$,"\")) Endif ' A&=Instr(Parx$,"PARX.SYS\") If A&>0 Parx$=Left$(Parx$,A&+8) Endif ' If Fsfirst(Parx$+"PARX.TRM",&H0)<>0 If Fsfirst(Parx$+"PARX.SYS",&H10)=0 Parx$=Parx$+"PARX.SYS\" Endif Endif ' Px_card!=((@Form_alert(1,"[2][Carte graphique standard?|(ST,TT,Falcon..)][ Oui |Non]"))<>1) If Fsfirst(Left$(Parx$,Max(0,Len(Parx$)-1)),&H10)=0 ! ok If @Form_alert(1,"[2][Sauver chemin?][Confirmer|Annuler]")=1 Gosub Sv.parx Endif Endif Endif Return Procedure Read_trm Local File$ Local Adr% Local E%,H% Local L% ' If Trm%>0 ~@Mfree(Trm%) Trm%=-1 Endif ' Adr%=Fgetdta() If Left$(Nom_trm$,8)="SWIFTELP" File$=Set_path$+"SYSTEME\SWIFTELP.TRM" Else File$=Parx$+Nom_trm$+Chr$(0) Endif If Not @Exist(File$) Nom_trm$="PARX.TRM" File$=Parx$+Nom_trm$+Chr$(0) Endif If @Exist(File$) Gosub Defmouse(2) ' Fileh&=@Fopen(File$,0) L%=Long{Adr%+26} ! len Trm%=@Malloc(L%) If Trm%>0 ~@Tsterr(@Fadrread(Fileh&,Trm%,L%)) Endif ~@Tsterr(@Fclose(Fileh&)) ' If Trm%>0 If Long{Trm%}=Cvl("PARX") And Long{Trm%+4}=Cvl("_TRM") Select Word{Trm%+8} Case 200 To 299 Default ~@Form_error(1,"[3][Erreur au chargement du TRM|Version non reconnue|Contactez PARX][ Annuler ]") ~@Mfree(Trm%) Endselect Else ~@Form_alert(1,"[3][Fichier TRM non reconnu!][Annuler]") ~@Mfree(Trm%) Endif Endif ' Else Clr Trm% ~@Form_error(1,"[3][Erreur au chargement du TRM| (non trouv‚)][ Annuler ]") Endif ' Return Procedure Rim_uninit If Rim%>0 ~@Mfree(Rim%) 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 Return Function Rim_rd $F% Local L% Local Fileh& Local File$ ' If Rim%>0 ~@Mfree(Rim%) Endif File$=Parx$+"RIM\"+Nom_rim$+Chr$(0) If @Exist(File$) Fileh&=@Fopen(File$,0) If @Tsterr(Fileh&) L%=Long{Adr%+26} ! len Rim%=@Malloc(L%) ' If Rim%>0 ~@Tsterr(@Fadrread(Fileh&,Rim%,L%)) If Long{Rim%}=Cvl("READ") And Long{Rim%+4}=Cvl("_IMG") $S% Select Long{Rim%+8} Case "_VDI","_SHI","_VSH" Select Word{Rim%+12} Case 0,1,2,3 ! types OK A$=Upper$(Char{Rim%+24}) If Instr(A$,"JPG")>0 Or Instr(A$,"JPEG")>0 ' Ok Else ~@Mfree(Rim%) ~@Form_alert(1,"[3][Fichier RIM non JPeG!][Annuler]") Return 1 Endif Default ~@Mfree(Rim%) ~@Form_alert(1,"[3][Fichier RIM non reconnu!][Annuler]") Return 2 Endselect Default ~@Mfree(Rim%) ~@Form_alert(1,"[3][Fichier RIM non reconnu!][Annuler]") Return 3 Endselect $S& Else ~@Mfree(Rim%) ~@Form_alert(1,"[3][Fichier RIM non reconnu!][Annuler]") Return 4 Endif Else ~@Mfree(Rim%) ~@Form_alert(1,"[3][Fichier RIM non reconnu!][Annuler]") Return 5 Endif ~@Tsterr(@Fclose(Fileh&)) Endif Endif ' Return (Rim%>0) Endfunc ' ' On donne un fichier RIM -> d‚codage/transfert en taille/plans etc... Function Transf(Adr%,Len%) $F% Local A&,W&,H& Local N& Local Mf1%,Mf2%,Mf3% Local R%,E% Local F% Local B%,C%,S%,T%,M%,M2% Local Z& Local F&,D& Local L%,L2% Local D% Local A$ Local A!,B! ' ' F%=-1 ! Retour pr‚d‚fini If Trm%>0 And Rim%>0 ' ' R‚servation pour 3 struct Mfdb et pour une palette Mf1%=@Malloc(60+1536) Mf2%=Mf1%+20 Mf3%=Mf1%+40 Mpal%=Mf1%+60 ' ' Largeur & Hauteur pr‚d‚finies pour Test_file() W&=Work_out(0)+1 H&=Work_out(1)+1 ' If Ph_col|=0 And Gris! ! actuelle+gris=auto+gris Ph_col|=4 ! auto Else if Ph_col|=2 And Gris! ! actuelle+image=auto+gris Ph_col|=4 ! auto Endif ' ' ---------------------------------------- ' R‚glages pour le tramage (aprŠs) $S& Select Ph_col| Case 0 ! std A!=False D&=&X0 ! imposer std B!=False Case 1 A!=True ! changer palette D&=&X1000 ! gris B!=False Case 2 A!=True ! changer palette D&=&X100 ! palette propos‚e B!=False Case 3 ! palette TRM A!=True D&=&X100 ! palette propos‚e B!=True ! recopier palette TRM ' Case 4 ! AUTO B!=False If Gris! A!=False ! palette actuelle D&=&X0 ! impos‚e Else ! propos‚e actuelle=actuelle A!=True ! proposer & changer D&=&X100 Endif ' Default ! inconnu A!=False D&=0 B!=False Endselect ' ' Ph_tramp| = M‚thode de tramage ' ---------------------------------------- ' ' ' Adresse non fictive? Mfdb bien r‚serv‚e? If Adr%>0 If Mf1%>0 ' ' Pr‚Remplissage de la Mfdb pour Test_file(): ' ---------------------------------------- Long{Mf1%}=0 ! dummy Word{Mf1%+4}=W& Word{Mf1%+6}=H& Word{Mf1%+8}=(W&+15)\16 ' $S% Select Long{Rim%+8} Case "_VDI","_VSH" Word{Mf1%+10}=1 ! format Case "_SHI" Word{Mf1%+10}=0 ! format Endselect $S& Word{Mf1%+12}=Plans& ! nbr plans actuel Long{Mf1%+14}=@Ncol(Plans&)*6 ! nbr octets palette Word{Mf1%+18}=&H0 ! fictif (pas de fichier ouvert!) ' ---------------------------------------- ' ' print "test file" ' *** Test file *** R%=Rim%+56 E%=C:R%(W:0,L:Adr%,L:Len%,L:Len%,L:Cvl(Ext$),L:Mf1%) ' Select E% Case 2,3 ! Test_file Ok ' ' R‚cup‚r‚r dimensions image W&=Word{Mf1%+4} H&=Word{Mf1%+6} ' ' ' V‚rifier coh‚rence de la largeur en mots Word{Mf1%+8}=(Word{Mf1%+4}+15)\16 ' ' N=Nbr couleurs SOURCE (pas d'‚cran forc‚ment) N&=@Ncol(Word{Mf1%+12}) ' Palette source If N&>0 ! <>TrueColor Pal%=@Malloc(N&*6) If Pal%<=0 @Err.info("Erreur m‚moire PAL pleine") Endif Else Clr Pal% ! Pas de palette (TC) Endif ' ' B=Adresse+Seek (adresse de la palette) B%=Adr%+Long{Mf1%} ! adresse+seek palette: donn‚es palette C%=Long{Mf1%+14} ! taille palette source Long{Mf1%}=Len% ! communiquer encore taille "disk" ' ' print "B%=";B%;" C%=";C%;" PAL%=";Pal%;" N=";N&;" Mf1%=";Mf1% ' ' print "get palette" ' *** Get palette *** R%=Rim%+60 E%=C:R%(W:0,L:B%,L:C%,L:Pal%,L:N&,L:Mf1%) If E%<>2 E%=3 ! palette standard Endif ' ' -------------------------------------------------- ' Ne devrait pas arriver (sauter cette partie): ' G‚n‚rer palette ou charger si il n'y en a aucune.. ' -------------------------------------------------- If Pal%>0 ! palette source existe If E%=3 ! mais non cr‚‚e ' ' Recopier du trm! Select N& Case 1 Bmove Trm%+12,Pal%,N&*6 Clr E% Case 4 Bmove Trm%+12+2*7,Pal%,N&*6 Clr E% Case 16 Bmove Trm%+12+(2+4)*7,Pal%,N&*6 Clr E% Case 256 Bmove Trm%+12+(2+4+16)*7,Pal%,N&*6 Clr E% Endselect ' If E%=3 ! g‚n‚rer soi-mˆme! pas g‚nial.. car si r‚sol <> on est foutu! ' G‚n‚rer palette... berk! 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+$ And And And And Eqv And }=Intout(2) Word{Pal%+Z&*6+$ And And And And Eqv Or }=Intout(3) Next Z& Endif Endif ! palette g‚n‚r‚e Endif ! pal%>0 ' ---------------------------------------- ' Ok, palette Source (Pal%) prˆte de tt fa‡on ' ---------------------------------------- ' ' S%=Long{Mf1%} ! seek pour les donn‚es de l'image ' print "seek= ";Str$(S%) ' Note: S%=0 pour le driver jpeg ' T%=Long{Mf1%+14} ! taille buffer … r‚server au rim ' Note: =Len% pour le driver jpeg ' B%=@Malloc(T%) ! adresse BUFFER If B%>0 ! OK ' Copier Bmove Adr%+S%,B%,Len%-S% Endif ' print "Taille BUFFER=";T%;" en ";B% ' ' ' print "haut ";Word{Mf1%+6};" larg plan ";Word{Mf1%+8};" plan ";Word{Mf1%+12},, ' ' V‚rifier la taille d'un plan (on ne sait jamais) Word{Mf1%+8}=(Word{Mf1%+4}+15)\16 ' ' Taille de notre buffer destination M% L%=Word{Mf1%+6}*Word{Mf1%+8}*2*Word{Mf1%+12} M%=@Malloc(L%) ! R‚server m‚moire destination ' If M%>0 ! ok r‚servation ' Long{Mf1%}=M% ! adresse buffer destination ds 1er mot Long{M%}=L% ! len (s‚curit‚) ' ' *** Do file *** ' ' print "do file" R%=Rim%+64 ! do file E%=C:R%(W:0,L:B%,L:Len%-S%,L:Mf1%) ' ' Lib‚rer buffer ~@Mfree(B%) ' $S% Select E% Case 3,5,512 To ! ok that's all good! ' print "OK, traitement RIM achev‚" ' ' ---------------------------------------- @Eminfo("D‚codage de l'image photo en cours.. \") ' Tramage ' If False If True ! ON TRAME!! ' ' Nombre de couleurs N&=@Ncol(Plans&) ' ' G‚n‚rer palette destination: NOTRE palette de NOTRE r‚solution cette fois! If Mpal%>0 If N&>0 ! <>TC If B! ! palette trm Select N& Case 1 Bmove Trm%+12,Mpal%,N&*6 Case 4 Bmove Trm%+12+2*7,Mpal%,N&*6 Case 16 Bmove Trm%+12+(2+4)*7,Mpal%,N&*6 Case 256 Bmove Trm%+12+(2+4+16)*7,Mpal%,N&*6 Endselect ' Else 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{Mpal%+Z&*6}=Intout(1) Word{Mpal%+Z&*6+2}=Intout(2) Word{Mpal%+Z&*6+4}=Intout(3) Next Z& Endif Endif Endif ' For A&=0 To 19 Byte{Mf2%+A&}=Byte{Mf1%+A&} Next A& Word{Mf2%+10}=0 ! format 0 Word{Mf2%+12}=Plans& F&=Word{Mf1%+10} ! sauver format (0,1) Long{Mf2%}=0 ! Dixit D2M ' ' print "test trame file" ' *** Test Trame file - Inquire *** R%=Trm%+&H7A6+2 ' E%=C:R%(W:0,W:ph_tramp|,L:0,L:Mf1%,L:Pal%,L:Mf2%,L:Mpal%,W:&X100) ' E%=C:R%(W:0,W:ph_tramp|,L:0,L:Mf1%,L:0,L:Mf2%,L:0,W:&X100) ' **Ne pas mettre Mf2% mais 0 mais bon.. NON! 0 dans adr c tout ' E%=C:R%(W:0,W:Ph_tramp|,L:0,L:Mf1%,L:0,L:Mf2%,L:0,W:D&) E%=C:R%(W:0,W:Ph_tramp|,L:0,L:Mf1%,L:0,L:Mf2%,L:Mpal%,W:D&) ' If E%=>0 If E%>0 If E%=&H7FFFFFFF ! malloc all!! E%=Malloc(-1) Sub E%,Word{Mf1%+6}*Word{Mf1%+8}*2*Word{Mf1%+12}*3 Sub E%,Supmem% E%=Max(33000,E%) Endif ' ' XXXXXXXXXXXXXXXXXXXXXXXXXXX ' **Ya un BUG ici! Pur‚e.. oblig‚ de r‚server plus de m‚moire..** B%=@Malloc(E%+Supmem%) If B%=>0 Long{B%}=E% ! indiquer taille bloc! Endif Else B%=1 Endif If B%>0 If B%=1 Clr B% Endif ' If Word{Mf1%+10}<>F& ! format initial diff‚rent? ' ' Transf‚rer.. D%=@Malloc(Word{Mf1%+6}*ElseMf1%+8}*2*Word{Mf1%+12}) If D%>0 ' For A&=0 To 19 Byte{Mf3%+A&}=Byte{Mf1%+A&} Next A& Long{Mf3%}=D% Word{Mf3%+10}=Word{Mf1%+10} ! nouv format ' Long{Mf1%}=M% ! adresse src Word{Mf1%+10}=F& ! anc format src <> nouveau ' Contrl(0)=110 ! transform format 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! ' ~@Mfree(M%) ! ancien: lib‚rer M%=D% Clr D% Long{Mf1%}=M% ! nouvelle adresse Word{Mf1%+10}=Word{Mf3%+10} ! nouv format ' Else ~@Mfree(M%) ' ~@Form_alert(1,"[3][Plus de m‚moire disponible!|(trnsf)][ Annuler ]") @Err.info("Plus de m‚moire disponible pour transfert ("+Str$(Malloc(-1))+")") Endif Endif ' ' print "nouv ";Word{Mf1%+10},"xxx ";Word{Mf2%+10} If M%>0 ' ' Nouveau bloc agrandit pour Plans& L2%=Word{Mf2%+6}*ElseMf2%+8}*2*Word{Mf2%+12} L2%=Max(L2%,L%) ! au moins le fichier!! ' Bitmap%=@Malloc(L2%+4) If Bitmap%>0 ! OK ' (fausse) taille destination Long{Bitmap%+4}=Word{Mf2%+6}*Word{Mf2%+8}*2*Word{Mf2%+12} ' If Long{Mf2%}<>0 ! on trame sur le mˆme fichier! ' ~C:qcopy%(L:M%,L:Bitmap%+4,L:L%) ! copier Bmove M%,Bitmap%+4,L% ! copier ~@Mfree(M%) ! lib‚rer ancien (trop petit now) ' M%=Bitmap%+4 ! scr=dest Long{Mf1%}=Bitmap%+4 ! adresse d‚part Long{Bitmap%+4}=L2% ! s‚curit‚ Endif ' ' ' print "trame file" Long{Mf2%}=Bitmap%+4 ! adresse destination R%=Trm%+&H7A6+2 ' *** Trame file *** ' E%=C:R%(W:0,W:ph_tramp|,L:B%,L:Mf1%,L:Pal%,L:Mf2%,L:Mpal%,W:&X100) E%=C:R%(W:1,W:Ph_tramp|,L:B%,L:Mf1%,L:Pal%,L:Mf2%,L:Mpal%,W:D&) ' ' Effacer ‚ventuellement ancien bloc! If M%<>Bitmap%+4 ~@Mfree(M%) Else M%=-1 Endif ' Effacer buffer tempo du tramer ~@Mfree(B%) ' If E%<0 ' ~@Form_alert(1,"[1][Tramage impossible!|#2][ Annuler ]") @Err.info("Tramage impossible!") ~@Mfree(Bitmap%) Else ' ' print "r‚sultat:",Word{Mf2%+10} If Word{Mf2%+10}<>0 ! Re-transfert vers ‚cran M%=@Malloc(Word{Mf2%+6}*Word{Mf2%+8}*2*Word{Mf2%+12}+4) ' If M%>0 For A&=0 To 19 Byte{Mf3%+A&}=Byte{Mf2%+A&} Next A& Long{Mf3%}=M%+4 Word{Mf3%+10}=0 ! format ‚cran ' ' print "retransfert final de ";Word{Mf2%+10},"… ";Word{Mf3%+10} ' 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(Mf3%)) Contrl(10)=Word(Mf3%) Vdisys ! transform form! Else @Err.info("Tramage impossible!") Endif ' ~@Mfree(Bitmap%) Bitmap%=M% M%=-1 ' Else ! transfert de s‚curit‚ M%=@Malloc(Word{Mf2%+6}*Word{Mf2%+8}*2*Word{Mf2%+12}+4) If M%>0 Bmove Bitmap%,M%,Word{Mf2%+6}*Word{Mf2%+8}*2*Word{Mf2%+12}+4 ~@Mfree(Bitmap%) Bitmap%=M% Else @Err.info("Tramage impossible!") ~@Mfree(Bitmap%) Endif M%=-1 ' Endif ' If Bitmap%>0 Word{Bitmap%}=W& Word{Bitmap%+2}=H& ' ' Changer palette? If A! And (N&>0) And (Mpal%>0) Mcol!=True Clr Col$ For A&=0 To N&-1 Col$=Col$+Mki$(Word{Mpal%+A&*6})+Mki$(Word{Mpal%+A&*6+2})+Mki$(Word{Mpal%+A&*6+4}) Next A& Gosub Set_col(True) ! palette en cours Endif ' F%=Bitmap% ! ok ouf!!! Bitmap%=-1 ' ' print " OK",W&,H& ' Endif ' Endif Else ' ~Form_alert(1,"[3][Plus de m‚moire disponible!|(trns2)][ Annuler ]") @Err.info("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 ]") @Err.info("Plus de m‚moire disponible ("+Str$(Malloc(-1))+")") Endif If B%>0 ~@Mfree(B%) Endif Else ' ~@Form_alert(1,"[1][Tramage impossible!|#1][ Annuler ]") @Err.info("Tramage impossible") Endif Endif ' Default F%=-1 ! erreur Endselect ' Else ' ~@Form_alert(1,"[3][Erreur m‚moire JPG pleine][ABANDON]") @Err.info("Erreur m‚moire JPG pleine") F%=-1 ! erreur Endif ' ' ' ' Default ~@Form_error(1,"[3][Erreur JPeG][ABANDON]") F%=-1 ! erreur Endselect ' ~@Mfree(Mf1%) Else ~@Form_error(1,@Errf$(-39)) F%=-1 ! erreur Endif Else ~@Form_error(1,"[3][Erreur interne #RTPA1 !|A signaler][ABANDON]") F%=-1 ! erreur Endif ' If M%>0 ~@Mfree(M%) Endif If B%>0 ~@Mfree(B%) Endif If M2%>0 ~@Mfree(M2%) Endif If Pal%>0 ~@Mfree(Pal%) Endif If Bitmap%>0 ~@Mfree(Bitmap%) Endif ' ' ~Inp(2) ' If F%=>0 ' On a l'image, il faut v‚rifier la taille, et la couper au besoin! Gosub Xtrnsf(F%) Endif Endif ' ' Il faut l'agrandir!! ' (Euh aprŠs) ' ' Return F% ! Retour Endfunc Function Ncol(P&) ! Nbr de couleurs pour le Nbr de plans P $F% $S& Select P& Case 1 ! mono Return 2 Case 2 ! 4 coul Return 4 Case 4 ! 16 coul Return 16 Case 8 ! 256 coul Return 256 Default Return 0 ! TC Endselect Endfunc Procedure Xtrnsf(Var F%) If Imp(Accp!,Word{F%}<=320 And Word{F%+2}<=240) ! Error! Word{F%+2}=(Word{F%+2}\10)*10 ! Couper par blocs de 10! Else Err.info("Erreur photographie trop grande pour l'‚cran!") ~@Mfree(F%) F%=-1 Endif ' Return ' ' Routine d'agrandissement/r‚duction d'image par paquets ' Convertit l'image F% compos‚e de blocs 8*10 en une image ' compos‚e de blocs Eccsizex&*Eccsizey& ' Ces blocs sont invisibles ‚videmment, "virtuels", car l'image ' JPEG est transf‚r‚e dans son int‚gralit‚ sans ce genre de consid‚rations Function Xgtrnsf(F%) $F% Local Adr%,Adr2% Local A&,T& Local X&,Y& Local M& Local Mf1%,Mf2% Local B&,C&,P& Local Z& ' ' Routine d'‚tirement ½RX'96 Adr%=0 If Pt&(0,0)<>-1 And Pt&(1,0)<>-$ And And And And Imp A!è5!âfÌ @aÉÈÿÿÿÿff trait‚ r @pŸîf0 ¥¼èp Ý€€ÿfr -1=aucune au 1er plan 0 ž"è6fÝÌ "à žìÉf ^n, next window 8Ÿîv#èp f ž‚âè Ý€ÿfw8Ÿîv#è ߀ÿ f$f ž¶â Ý€$*)Mks$(Trace$Cvs(Bin$()Trace$Cfloat()String$(Bin$(Cvs( With Mkf$( With ) As Frac(Cvs( Offset Char{Deg(Mkf$(Mid$(<= And + Or &O1500000022 Or Time$ And Float{@Malloc(40) ' Mf1%=@Malloc(40) Mf2%=Mf1%+20 If Mf1%>0 ' Long{Mf1%}=F%+4 Long{Mf1%+4}=Long{F%} ! W et H! Word{Mf1%+8}=(Word{Mf1%+4}+15)\16 Word{Mf1%+12}=Plans& ' ' Nouvelle image calcul‚e et agrandie, ' ATTENTION! hauteur maximale des deux (original, agrandie) car si on ' r‚tr‚cit il faut tout de mˆme pour le 1er transfert en largeur avoir ' toute la hauteur! Ce bug ‚tait vicieux! Word{Mf2%+4}=(ElseMf1%+4}\8)*Eccsizex& Word{Mf2%+6}=Max(Word{Mf1%+6},(Word{Mf1%+6}\10)*Eccsizey&) Word{Mf2%+8}=(Word{Mf2%+4}+15)\16 Word{Mf2%+12}=Plans& ' ' Plus 2, au cas o— il y aurait des d‚bordements.. NAN SII! ' Adr%=@Malloc(Word{Mf2%+6}*Word{Mf2%+8}*2*Word{Mf2%+12}+4) Adr%=@Malloc((Word{Mf2%+6}+12)*Word{Mf2%+8}*2*Word{Mf2%+12}+4) If Adr%>0 ' Long{Adr%}=Long{Mf2%+4} ! copier dimensions Long{Mf2%}=Adr%+4 ! adresse image dest ' ' ' Destination prˆte, ‚tirer ' ---------------------------------------- ' On ‚tire en largeur If Pt&(0,0)<>-1 ! -1=ne rien faire! X&=0 ! en x=0 B&=0 C&=Word{Mf1%+4}-1 If Eccsizex&<8 Swap B&,C& Endif P&=Sgn(C&-B&) For A&=B& To C& Step P& ' Dans Pt&(0,Mod(A&,8)) il y a l'‚paisseur du trait en X ' M&=Mod(A&,8) If Pt&(0,M&)>0 For T&=0 To Pt&(0,M&)-1 ! From frame 2 to .. ' Copier lignes ' Contrl(0)=109 ! vro_cpyfm Contrl(1)=4 Contrl(3)=1 Contrl(6)=V~h Contrl(7)=Word(Swap(Mf1%)) Contrl(8)=Word(Mf1%) Contrl(9)=Word(Swap(Mf2%)) Contrl(10)=Word(Mf2%) Intin(0)=3 Ptsin(0)=A& Ptsin(1)=0 Ptsin(2)=Ptsin(0) Ptsin(3)=Word{F%+2}-1 ! coord vdi! If P&=1 Ptsin(4)=X&+T& Else Ptsin(4)=(Word{F%}\8)*Eccsizex&-(X&+T&) Endif Ptsin(5)=0 Ptsin(6)=Ptsin(4) Ptsin(7)=Ptsin(3) Vdisys ! transfert ' Next T& Endif ' Add X&,Pt&(0,M&) ! en plus Next A& ' ' If X&<>(Word{F%}\8)*Eccsizex& ' print X&,(Word{F%}\8)*Eccsizex& ' Endif ' Endif ' ' On ‚tire en hauteur If Pt&(1,0)<>-1 ! -1=ne rien faire! Y&=0 ! en y=0 B&=Word{Mf1%+6}-1 C&=0 If Eccsizey&<10 Swap B&,C& Endif P&=Sgn(C&-B&) For A&=B& To C& Step P& ' Dans Pt&(1,Mod(A&,10)) il y a l'‚paisseur du trait en Y ' M&=Mod(A&,10) If Pt&(1,M&)>0 ! si 1 alors identique! For T&=0 To Pt&(1,M&)-1 ! From frame 2 to .. ' Copier lignes ' 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(Mf2%)) Contrl(10)=Word(Mf2%) Intin(0)=3 Ptsin(0)=0 Ptsin(1)=A& Ptsin(2)=Word{Mf2%+4}-1 Ptsin(3)=Ptsin(1) ! coord vdi Ptsin(4)=0 If P&=-1 Ptsin(5)=Word{Mf2%+6}-(Y&+T&)-1 ' Z&=(Word{F%+2}\10)*Eccsizey&-(Y&+T&) Else Ptsin(5)=Y&+T& ' Z&=Y&+T& Endif ' Ptsin(6)=Ptsin(2) Ptsin(7)=Ptsin(5) ! coord vdi Vdisys ! transfert ' ' ~C:qcopy%(L:Long{Mf2%}+Word{Mf2%+8}*A&,L:Long{Mf2%}+Word{Mf2%+8}*Z&,L:Word{Mf2%+8}) ' Next T& Endif ' Add Y&,Pt&(1,M&) ! en plus Next A& ' ' If Y&<>(Word{F%+2}\10)*Eccsizey& ' print Y&,(Word{F%+2}\10)*Eccsizey& ' Endif ' Endif Endif ' Endif Endif ' ' Recopier dans un bloc + petit If Adr%>0 Adr2%=@Malloc(Word{Mf2%+6}*ElseMf2%+8}*2*Word{Mf2%+12}+4) Bmove Adr%,Adr2%,Word{Mf2%+6}*Word{Mf2%+8}*2*Word{Mf2%+12}+4 ~@Mfree(Adr%) Adr%=Adr2% Clr Adr2% Word{Adr%}=(Word{Mf1%+4}\8)*Eccsizex& Word{Adr%+2}=(Word{Mf1%+6}\10)*Eccsizey& Endif ~@Mfree(Mf1%) ' Return Adr% Endfunc ' ' Recalculer agrandissement de toute les images Procedure Pho_calc Local A& Local Adr% Local A! ' If Np&>1 Gosub Defmouse(2) ' Tout effacer: Po% (objets recalcul‚s) For A&=1 To Np&-1 Gosub Defmouse(2) Adr%=Po%(A&) ~@Mfree(Adr%) Po%(A&)=Adr% Next A& ' If Pc_x&<>Eccsizex& Or Pc_y&<>Eccsizey& ' Tout recalculer A!=False For A&=1 To Np&-1 Gosub Defmouse(2) If Pza%(A&)=Long{Pa%(A&)} Po%(A&)=@Xgtrnsf(Pa%(A&)) ! Agrandir l'image If Po%(A&)<0 ! si =0 mˆme taille? A!=True Else if Po%(A&)>0 Pzo%(A&)=Long{Po%(A&)} Endif Else Po%(A&)=0 ! ne pas agrandir.. ' ..et ne toucher … rien! Endif Next A& If A! ~@Form_error(1,@Errf$(-39)) Endif Pc_x&=Eccsizex& Pc_y&=Eccsizey& Gosub Defmouse(0) ' Else ! ne devrait jamais arriver.. Arrayfill Po%(),0 ! pas la peine de recalculer! Endif Endif Return ' ' Supprimer image agrandie.. en cas d'‚crasement! Et refaire le calcul!! Procedure Unxg(A&) Local Adr% ' Gosub Defmouse(2) Emtechinfo("Erreur transfert image agrandie, recalcul..") ' Gosub Defmouse(2) Adr%=Po%(A&) ~@Mfree(Adr%) Po%(A&)=0 ! cancelled ' If Pza%(A&)=Long{Pa%(A&)} Po%(A&)=@Xgtrnsf(Pa%(A&)) ! Agrandir l'image If Po%(A&)<0 ! si =0 mˆme taille? Emtechinfo("Erreur recalcul "+Str$(Po%(A&))) ' A!=True Po%(A&)=0 ! cancelled.. Else if Po%(A&)>0 Emtechinfo("Image recalcul‚e") Pzo%(A&)=Long{Po%(A&)} Endif Else Emtechinfo("Erreur transfert image originale, recalcul impossible!") Po%(A&)=0 ! ne pas agrandir.. ' ..et ne toucher … rien! Endif Gosub Defmouse(0) ' Return ' ' ' ' Procedure Emcut(A!) Local My&,My2&,Mx&,Mx2&,X&,Y& Local P$ ' If @Tstblk If Len(Register$)>0 Mx&=0 My&=1 Mx2&=Vmax_x&+1 My2&=Vmax_y& ' ' binair$="" Clr Binp% Clr P$ For Y&=My& To My&+My2&-1 Clr P$ For X&=Mx& To Mx&+Mx2&-1 If (Not 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$ ' ' Protection If Not @Check2 ! pirate! ' Plans&=Plans&+1 ! re-gnagnagna Cache%=Clrblk% ! Un beau boum en perspective! Endif ' P$=Mid$(Trim$(P$),2) ' binair$=binair$+P$+Cr$ @Copblk(P$+Cr$) Next Y& ' Endif Endif ' Return Procedure Saveclp If @Tstblk If Len(Register$)>0 Gosub Defmouse(2) Fileh&=@Fcreate(Scrap$+"SCRAP.TXT",0) If @Tsterr(Fileh&) ' ~@Tsterr(@Fwrite(Fileh&,binair$)) ~@Tsterr(@Fadrwrite(Fileh&,Binair%,Binp%)) ~@Tsterr(@Fclose(Fileh&)) Endif Gosub Defmouse(0) Endif Endif Return Procedure Saveclp2 If @Tstblk If Len(Register$)>0 Gosub Defmouse(2) Fileh&=@Fcreate(Scrap$+"SCRAP.VDT",0) If @Tsterr(Fileh&) ' ~@Tsterr(@Fwrite(Fileh&,binair$)) ~@Tsterr(@Fadrwrite(Fileh&,Binair%,Binp%)) ~@Tsterr(@Fclose(Fileh&)) Endif Gosub Defmouse(0) Endif Endif Return Procedure Printbnr Local A! Local A& ' If @Tstblk A!=Gemdos(17) If Not A! A!=(@Form_alert(1,"[3][Imprimante ne r‚ponde pas][ Re-essayer | Annuler ]")=1) Endif ' If Len(Register$)>0 If A! Gosub Defmouse(2) ' For A&=1 To Len(binair$) For A&=0 To Binp%-1 ' @Lprint(Mid$(binair$,A&,1)) @Lprint(Chr$(Byte{Binair%+A&})) Next A& @Lprintl("") @Lprint(Chr$(12)) Gosub Defmouse(0) ' Endif Endif Endif ' Return Procedure Delclp Local A$ ' Gosub Defmouse(2) A$=Scrap$+"SCRAP.TXT"+Chr$(0) ~Gemdos(65,L:Varptr(A$)) A$=Scrap$+"SCRAP.1ST"+Chr$(0) ~Gemdos(65,L:Varptr(A$)) A$=Scrap$+"SCRAP.VDT"+Chr$(0) ~Gemdos(65,L:Varptr(A$)) ' Gosub Clp_lire(-1) Gosub Defmouse(0) Return Procedure View_clip Local A!,B!,C! Local A$ Local F$ ' A!=@Exist(Scrap$+"SCRAP.TXT") B!=@Exist(Scrap$+"SCRAP.1ST") C!=@Exist(Scrap$+"SCRAP.VDT") ' If B! Gosub Clp_lire(1) Gosub Clp_img(1) Endif ' A$="[3][PRESSE-PAPIER:|" If (Not A!) And (Not B!) And (Not C!) A$=A$+"Vide!" Else If A! F$=Scrap$+"SCRAP.TXT" A$=A$+"SCRAP.TXT ("+Str$(@Filesize(F$))+"o)|" Endif If B! F$=Scrap$+"SCRAP.1ST" A$=A$+"SCRAP.1ST ("+Str$(@Filesize(F$))+"o)|" Endif If C! F$=Scrap$+"SCRAP.VDT" A$=A$+"SCRAP.VDT ("+Str$(@Filesize(F$))+"o)" Endif Endif ' A$=A$+"][Confirmer]" ~@Form_alert(1,A$) ' Return Procedure Copy_clip E$=Scrap$+"SCRAP.TXT" If @Exist(E$) F$=@Fsel$("\*.TXT","SCRAP.TXT","Copie") If Len(F$)>0 Fmshow("Copie en cours") Gosub Copy(E$,F$) Fmhide Endif Endif E$=Scrap$+"SCRAP.1ST" If @Exist(E$) F$=@Fsel$("\*.1ST","SCRAP.1ST","Copie") If Len(F$)>0 Fmshow("Copie en cours") Gosub Copy(E$,F$) Fmhide Endif Endif E$=Scrap$+"SCRAP.VDT" If @Exist(E$) F$=@Fsel$("\*.VDT","SCRAP.VDT","Copie") If Len(F$)>0 Fmshow("Copie en cours") Gosub Copy(E$,F$) Fmhide Endif Endif Return ' Procedure Imcut(Flag!) Local X&,Y&,W&,H& ' If Len(Register$)>0 X&=X_desk& Y&=Y_desk& W&=W_desk& H&=H_desk& If Rc_intersect(W_ix&(4),W_iy&(4),W_iw&(4),W_ih&(4),X&,Y&,W&,H&) If Rc_intersect(W_ix&(4)+Emx&,W_iy&(4)+Emy&,(Vmax_x&+1)*Eccsizex&,(Vmax_y&+1)*Eccsizey&,X&,Y&,W&,H&) If Flag! File$(4)=Scrap$+"SCRAP.BLK" Endif Gosub Emtransf(Flag!,X&,Y&,W&,H&) Endif Endif Endif Return ' Procedure Copie Local E$,F$ ' E$=@Fsel$("\*.*","","Original") If Len(E$)>0 F$=@Fsel$("\*.*",E$,"Copie") If Len(F$)>0 Fmshow("Copie en cours") Gosub Copy(E$,F$) Fmhide Endif Endif ' Return Procedure Copy(E$,F$) Local H&,I& Local Adr%,L%,T% ' Fmshow("Copie en cours") If Len(E$)>0 E$=E$+Chr$(0) If @Exist(E$) L%=Long{Fgetdta()+26} ! taille ' If Len(F$)>0 F$=F$+Chr$(0) Gosub Defmouse(2) ' H&=@Fopen(E$,0) If H&=>0 ' I&=@Fcreate(F$,0) If I&=>0 ' T%=Min(L%,Malloc(-1)) Adr%=@Malloc(T%) If Adr%>0 ' While L%>T% Gosub Defmouse(2) ~@Tsterr(@Fadrread(H&,Adr%,T%)) Gosub Defmouse(2) ~@Tsterr(@Fadrwrite(I&,Adr%,T%)) L%=L%-T% Wend ~@Tsterr(@Fadrread(H&,Adr%,L%)) ~@Tsterr(@Fadrwrite(I&,Adr%,L%)) ' ~@Mfree(Adr%) Else ~@Form_alert(1,@Errf$(-39)) Endif ~@Fclose(I&) Else ~@Tsterr(I&) Endif ~@Fclose(H&) Else ~@Tsterr(H&) Endif ' Gosub Defmouse(0) Endif Endif Endif Fmhide ' 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$ ' If Len(Register$)>0 ' Bloc Clr E$ ! Bloc r‚sultant ' If Emulm|=0 ' 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&0 E$=E$+Esc$+"["+Str$(N&)+";"+Str$(X&)+"H" ! position E$=E$+T$ ! Ajouter ligne Endif Next N& ' Endif ' Endif ' Return E$ ! renvoyer Endfunc Function Minitext$(Mx&,My&,Mx2&,My2&) Local Y&,X& Local E$,P$ ' If Len(Register$)>0 Clr E$,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) Select Byte(Vids&(X&,Y&)) Case 127 P$=P$+" " Default P$=P$+Chr$(Vids&(X&,Y&)) Endselect Else P$=P$+" " Endif Else P$=P$+Chr$(Vids&(X&,Y&)) Endif Next X& P$=">"+P$ P$=Mid$(Trim$(P$),2) ' binair$=binair$+P$+Cr$ E$=E$+P$+Cr$ Next Y& Endif Return E$ Endfunc ' ' Manager de redraws videotexte ligne/ligne, XY pos, Length ' Vars management: A| (Acurs|), C& (Ccurs&), T| (Tcurs|) Function Minidraw$(X&,Y&,L&,Var A|,C&,T|) Local E$ Local C$ ! local ajt Local N& Local A& ' ' Bloc-ligne Clr E$ ' ' For N&=X& To X&+L&-1 N&=X& Do Clr C$ ' ' CaractŠre bas gauche (traiter normalement) If Byte(And(Div(Vids&(N&,Y&),&H100),&X1100))=0 ' If And(Vida|(N&,Y&),&X10011111)<>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 ' ' Manager de redraws 80 colonnes ligne/ligne, XY pos, Length Function Minidr80$(X&,Y&,L&,Var A|) Local N&,X& Local E$ ' Clr E$ For N&=X& To X&+L&-1 ' ' 1 light "surintensit‚" ' 4 soulign‚ "soulign‚" ' 5 clignotant "clignotant" ' 7invers‚ "invers‚ fond, n‚gatif" ' 9altern‚ ' 13alt '' ' 22"surintensit‚ normale" ' 24souligne off ' 25clignote off ' 27inverse off ' X&=Xor(Vida|(N&,Y&),A|) ! que doit-on changer? If X&<>0 If Vida|(N&,Y&)=0 ! normal E$=E$+Esc$+"["+"m" ' Else ! changer attributs ' ' 0 clignote If Btst(X&,0) If Btst(Vida|(N&,Y&),0) E$=E$+Esc$+"["+"5m" Else E$=E$+Esc$+"["+"25m" Endif Endif ' ' 1 lignage If Btst(X&,1) If Btst(Vida|(N&,Y&),1) E$=E$+Esc$+"["+"4m" Else E$=E$+Esc$+"["+"24m" Endif Endif ' ' 2 surintensit‚ If Btst(X&,2) If Btst(Vida|(N&,Y&),2) E$=E$+Esc$+"["+"1m" Else E$=E$+Esc$+"["+"22m" Endif Endif ' ' 3 invers‚ If Btst(X&,3) If Btst(Vida|(N&,Y&),3) E$=E$+Esc$+"["+"7m" Else E$=E$+Esc$+"["+"27m" Endif Endif ' ' 4 altern‚ (jamais utilis‚..) If Btst(X&,4) If Btst(Vida|(N&,Y&),4) E$=E$+Esc$+"["+"9m" Else E$=E$+Esc$+"["+"m" ! euh.. Endif Endif ' ' 5 caractŠre non ansi (fran‡ais) If Btst(X&,5) If Btst(Vida|(N&,Y&),5) E$=E$+Chr$(14) Else E$=E$+Chr$(15) Endif Endif ' Endif ' ' R‚actualis‚: A|=Vida|(N&,Y&) ' Endif ' ' CaractŠre! E$=E$+Chr$(Byte(Vids&(N&,Y&))) ' Next N& ' If And(A|,&X11010)=0 ! pas de fond E$=@Rtrim$(E$) ! couper espaces! Endif ' Return E$ Endfunc ' ' ' /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ /|\ ' 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& Local C& ' ' If Dim?(Edrcs|()) Gosub Drcs_uninit Endif ' 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,1,93,9) Arrayfill Edrcs|(),0 ' ' E$="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 ' If Len(Fnt_auto$)>0 ' Gosub Defmouse(2) ' open "I",#1,E$ If Len(Fnt_auto$)>8 If Left$(Fnt_auto$,8)="SWT2DRCS" C&=9 Clr T& While C&0 And D%=>0 And E%<=1 And D%<=93 For A&=0 To 9 Edrcs|(0,E%,D%,A&)=Asc(Mid$(A$,A&+1,1)) Edrcs|(1,E%,D%,A&)=Asc(Mid$(A$,A&+1,1)) Next A& Inc T& Endif Wend Else ~@Form_alert(1,Errp35$) Endif Else ~@Form_alert(1,Errp35$) Endif ' Gosub Defmouse(0) ' close #1 Endif ' ' Copie de If Fnt_auto$ ... If Len(Drfnt_auto$)>0 ' Gosub Defmouse(2) ' open "I",#1,E$ If Len(Drfnt_auto$)>8 If Left$(Drfnt_auto$,8)="SWT2DRCS" C&=9 Clr T& While C&0 And D%=>0 And E%<=1 And D%<=93 For A&=0 To 9 Edrcs|(1,E%,D%,A&)=Asc(Mid$(A$,A&+1,1)) Next A& Inc T& Endif Wend Else ~@Form_alert(1,Errp35$) Endif Else ~@Form_alert(1,Errp35$) Endif ' Gosub Defmouse(0) ' close #1 Endif ' Return Procedure Drcs_uninit ' Erase Drcs|() ' Erase Keep|() If Not Set_escape! ! Ne pas quitter sans effacer les champs Erase Edrcs|() Erase Mfdb1&(),Mfdb2&() 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 Gosub Defmouse(0) Endif Return ' ' save.sfd/sfv en bloc save ' ' ' ' 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& ' Clr A& Do ' max=2500 (100*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:$ And And And And Eqv Mod -1,W:A&) If A&=>0 If A&<2499 X&=Mod(A&,100) Y&=Div(A&,100) If Flag! If Vidp|(X&,Y&)=0 ! pas de photo Gosub Vdraw(X&,Y&) Endif Else Vidrd|(X&,Y&)=&HFF ! redraw quand mˆme ? Endif Endif Endif Inc A& Loop until A&<=0 Or A&>2499 Return ' 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|(0,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& Pc_a&=Rovcach& ' Return ' ' Procedure Eop ! avant edit Gosub Defmouse(2) Edit Return ' ' A partir d'ici, on peut apeller 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) ' ' Fausse erreur (tjs renvoy‚e … la fin) If Err=-37 Defmouse 2 Edit Endif ' ~@Form_alert(1,@Errf$(Err)) Gosub Outlog(@Errf$(E%)) Gosub Closelog ' 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 (Err=>0 And Err<=6) ~@Form_alert(1,"[1][Note: system error # "+Str$(Err)+" |ERflag: "+Chr$(-Fatal+48)+" |VDIflag: "+Str$(V~h)+" |APflag: "+Str$(Ap&)+" / MULflag: "+Str$(Multi!)+" ][ Hell! ]") @Outlog("[1][Note: system error # "+Str$(Err)+" |ERflag: "+Chr$(-Fatal+48)+" |VDIflag: "+Str$(V~h)+" |APflag: "+Str$(Ap&)+" / MULflag: "+Str$(Multi!)+" ][ Hell! ]") If Not Accessoire! On error gosub Eop Edit Endif ' 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! ]") @Outlog("[1][Note: system error # "+Str$(Err)+" |ERflag: "+Chr$(-Fatal+48)+" |VDIflag: "+Str$(V~h)+" |APflag: "+Str$(Ap&)+" / MULflag: "+Str$(Multi!)+" ][ Hell! ]") If Not Accessoire! On error gosub Eop Edit Endif Endif ' Do ~Evnt_mesag(Varptr(Wmenu&(0))) Loop ' Return ' ' Procedure Closetel ' ' send M_init etc.. inutile ' Return Procedure Resetv Outvid(Reset$) Return Procedure 300b If Set_speed! Delay 0.5 @Videmntl Outvid(V300b$) Delay 0.8 ~Xbios(15,9,0,174,-1,-1,-1) Delay 0.8 Endif @Videmntl Return Procedure 1200b If Set_speed! Delay 0.5 @Videmntl Outvid(V1200b$) Delay 0.8 ~Xbios(15,7,0,174,-1,-1,-1) Delay 0.8 Endif @Videmntl Return Procedure 4800b If Set_speed! Delay 0.5 @Videmntl Outvid(V4800b$) Delay 0.8 ~Xbios(15,2,0,174,-1,-1,-1) Delay 0.8 Endif @Videmntl Return Procedure 9600b If Set_speed! Delay 0.5 @Videmntl Outvid(V9600b$) Delay 0.8 ~Xbios(15,1,0,174,-1,-1,-1) Delay 0.8 Endif @Videmntl Return Procedure Setspeed Local A&,B& Local A$ ' Gosub Defmouse(2) $S& Select Speed& Case 0 @1200b Case 3 @300b Case 1 @4800b Case 2 @9600b Case 4 ' Select Emulm| Case 0,1,2 A$=Rsdefv$ Case 3 A$=Rsdef$ Endselect ' If Len(A$)=4 Or Len(A$)=6 Delay 0.2 A&=Val("$"+Mid$(A$,1,2)) ! config B&=Val("$"+Mid$(A$,1+2,2)) ! config ~Xbios(15,-1,B&,A&,-1,-1,-1) ! RSCONF Delay 0.2 Else Delay 0.2 ~Xbios(15,-1,0,174,-1,-1,-1) Delay 0.2 Endif 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 ' Reset vid‚otex local Procedure Loc_reset 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 Dmodet!=False Dmodeg!=False Vmode!=False Vtransp!=False ! plus de transparence Photo!=False Vdt_setme Return ' Function Answer $F% ' $S& Select Emulm| Case 0,1,2 Return Answer! Default ! case 3 Return False Endselect Endfunc ' ' ' send format‚ Procedure Send(Message$) ' Local A& ' If Redir! @Hidem @Vcurs0 Endif ' If Redir!=False If Capt|<>0 ! 1= capturer 2= fin page If Tcap|=1 If Magneto&=-1 ! pas de PAUSE If Len(Message$)=2 If Left$(Message$,1)=Sep$ Gosub Rec(Message$) ! record Endif Endif Endif Endif Endif ' @Tran(Message$) ' fsend(Tr_t$) Fdsend(Tr_t$) Else Send2(Message$) Endif If Lastsend|<=0 Lastsend|=10 ! on vient d'envoyer Endif ' If Redir! @Vcurs1 @Showm Endif ' 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! ' @write5(@Tran$(Mid$(Message$,sd_a,1)); @Tran(Mid$(Message$,Sd_a2&,1)) Fdsend(Tr_t$) Else Em_fl!=Sd_a! Em_c&=Asc(Mid$(Message$,Sd_a2&,1)) ' Gosub Emanage(Sd_a!,Asc(Mid$(Message$,Sd_a2&,1))) Gosub Emanage If Redt|=1 ! aussi!! ' @write5(@Tran$(Mid$(Message$,sd_a,1)); @Tran(Mid$(Message$,Sd_a2&,1)) Fdsend(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 Rec(A$) Local A& ' ' On enregistre juste les touches de fction If Len(A$)=2 If Left$(A$,1)=Sep$ If Binp%+Len(A$)=>Binlen% ~@Form_alert(1,"[1][Capture:|Buffer plein|Max: "+Str$(Binlen%\1024)+"K][ Fin ]") Capt|=0 Else For A&=1 To Len(A$) Byte{Binair%+Binp%}=Asc(Mid$(A$,A&,1)) Inc Binp% Next A& Endif Endif Endif ' Return Procedure Esend(A$) Local A!,B!,C! ' A!=Redir! B!=Answer! C!=Set_send! Redir!=True Answer!=False Set_send!=True Send(A$) Redir!=A! Answer!=B! Set_send!=C! Return Procedure Waitimer ' Local T% ' ' wait ' ' ' Gosub Defmouse(2) ' ' While (Timer-Sd_t%)<(200*L1200&)/120 While (Timer-Sd_t%)<(200*16)/120 ~Evnt_timer(2) ' Exit if Btst(@Bios11,2) Exit if @Shiftbrk Wend ' ' Clr L1200& Sd_t%=Timer ' Return ' ' Send direct Procedure Fsend(A$) If Rsdev&<>9999 For F_a&=1 To Len(A$) ~Bios(3,Rsdev&,Asc(Mid$(A$,F_a&,1))) Next F_a& Else @Inet_write(A$) Endif ' ~@Fwrite(Devh&,A$) Return Procedure Fdsend(Var A$) If Rsdev&<>9999 For F_a&=1 To Len(A$) ~Bios(3,Rsdev&,Asc(Mid$(A$,F_a&,1))) Next F_a& Else @Inet_write(A$) Endif Return ' ' Plus rapide, plus propre etc.. Procedure Adrsend(Adr%,Len%,Flag!) ' If Redir! If Flag! Flag!=False If @Firstw=4 Flag!=True Else If @W_tstview(4) ! mais voit-on la fenˆtre totalement? Flag!=True Endif Endif Endif Endif ' For Sd_a2&=0 To Len%-1 Em_fl!=Flag! Em_c&=Byte{Adr%+Sd_a2&} ' ' Envoi RS If Imp(Redir!,Redt|=1) Fsend(Chr$(Em_c&)) Endif ' Envoi ‚cran If Redir! Gosub Emanage Endif ' If Okwait! ! attente! ' On reprend ensuite Okw%=Sd_a2&+1 ! nbre … ‚liminer Exit if True Endif Next Sd_a2& ' Return Procedure Blsend(A$,Flag!) ' If Redir! If Flag! Flag!=False If @Firstw=4 Flag!=True Else If @W_tstview(4) ! mais voit-on la fenˆtre totalement? Flag!=True Endif Endif Endif Endif ' For Sd_a2&=1 To Len(A$) Em_fl!=Flag! Em_c&=Asc(Mid$(A$,Sd_a2&,1)) ' ' Envoi RS If Imp(Redir!,Redt|=1) Fsend(Chr$(Em_c&)) Endif ' Envoi ‚cran If Redir! Gosub Emanage Endif Next Sd_a2& ' Return ' ' Procedure Get_rs Local A&,B&,C&,D& Local A%,T% Local A$ Local N&,H& ! max int Local A$,B$ ' If Dim?(Rs&()) Erase Rs&(),Rn$() Endif Dim Rs&(20) Dim Rn$(20) ' Clr Rs$ Clr N& A%=@Cook_find(Cvl("RSVF")) If Not (A%>0 And Even(A%)) A%=@Cook_find(Cvl("RSVf")) Endif If A%>0 And Even(A%) Repeat T%=Lpeek(A%) D%=Lpeek(A%+4) If T%<>0 If D%=0 A%=T% Else D&=Byte(D%) C&=Byte(Shr(D%,8)) B&=Byte(Shr(D%,16)) A&=Byte(Shr(D%,24)) Add A%,8 If N&<20 If Btst(A&,7) ! interface If Btst(A&,6) ! reconnue GEMDOS If Btst(A&,5) ! reconnue BIOS A$=Char{T%} If Len(A$)>0 H&=@Fopen("U:\DEV\"+A$,2) ! I/O If H&=>0 ' B$=Space$(4*6) ~Gemdos(&H104,W:H&,L:V:B$,W:(Or(Rol(Asc("T"),8),129))) ~Gemdos(&H104,W:H&,L:V:B$,W:(Or(Rol(Asc("T"),8),130))) If Cvl(Left$(B$,4))<>0 Rs$=Rs$+@Rsp$(C&,A$) Rs&(N&)=C& Rn$(N&)=A$ ' If Len(Autors$)>0 If Autors$=A$ Serno&=N& ! noter Endif Endif ' Inc N& Endif ~@Fclose(H&) ' Endif Endif Endif Endif Endif Endif Endif Endif Until T%=0 Endif If Len(Rs$)=0 ' Standard Clr Rs$ Rs$=Rs$+@Rsp$(1,"RS232 (s‚rie)") Rs&(0)=1 Rn$(0)="AUX:" Rs$=Rs$+@Rsp$(3,"MIDI") Rs&(1)=3 Rn$(1)=@õ®è*ßœ@ f  key active dans emul?  Downto ]=Left$( Else Rs$=Rs$+"|" Rs$=Rs$+@Rsp$(1,"RS232 standard") Rs&(N&)=1 If @Exist("U:\DEV\AUX") Rn$(N&)="AUX" Else Rn$(N&)="AUX:" Endif ' Inc N& Rs$=Rs$+@Rsp$(1,"MIDI standard") Rs&(N&)=3 If @Exist("U:\DEV\MIDI") Rn$(N&)="MIDI" Else Rn$(N&)="MID:" Endif ' Inc N& Rs$=Rs$+@Rsp$(1,"Internet (STICK)") Rs&(N&)=9999 Rn$(N&)="@" ! INTERNET/RTEL ' Hsm!=True Endif ' Rs$=Left$(Rs$,Len(Rs$)-1) ! enlever dernier "|" Rs$="["+Rs$+"]" Gosub New_pop(Adr%(1),Rsc_ser&,Rs$) ' Rsdev&=Rs&(Serno&) If Rsdev&<>0 ' Nø pr‚d‚fini Rsdev&=1 Endif Return Procedure Iofile(Flag!) Local A$ ' ' On ferme toujours If Devh&=>0 If (Devh&<>9999) ~@Fclose(Devh&) Devh&=-1 Else @Inet_close Devh&=-1 Endif Endif ' ' Et on r‚-ouvre If Flag! If Rn$(Serno&)<>"@" ! pas inet If Hsm! If Right$(Rn$(Serno&),1)=":" Devh&=@Fopen(Rn$(Serno&),2) Else Devh&=@Fopen("U:\DEV\"+Rn$(Serno&),2) ! I/O Endif ' Clr Tio$ Clr Tio% If Devh&=>0 Clr Tio% Tio$=Space$(4*$ And And And And Eqv Or ) ~Gemdos(&H104,W:Devh&,L:V:Tio$,W:(Or(Rol(Asc("T"),8),129)))>=0 ! OK Tio%=Cvl(Left$(Tio$,4)) Endif Else If Right$(Rn$(Serno&),1)=":" Devh&=@Fopen(Rn$(Serno&),2) Else Devh&=@Fopen("U:\DEV\"+Rn$(Serno&),2) ! I/O Endif ' Clr Tio$ Clr Tio% Endif Rsdev&=Rs&(Serno&) ! device ' If Devh&<0 ' ~@Form_alert(1,"[1][Impossible d'ouvrir "+Rn$(Serno&)+"|(interface s‚rie)][Annuler]") Devh&=@Fopen("AUX:",2) Endif Else @Inet_open Devh&=9999 Endif Endif ' Return Function Rsp$(C&,A$) Return Str$(C&)+": "+A$+"|" Endfunc Function Cook_find(A%) ! Recherche $F% Local Jar%,Cook%,B% ' Clr B% ! Initialiser pointeur Jar%=Lpeek(&H5A0) ! Cookie jar?.. If Jar%>0 Do Cook%=Lpeek(Jar%) ! Id cookie actuel Add Jar%,4 If Cook%=A% ! Id? B%=Lpeek(Jar%) ! Oui, noter adresse Endif Add Jar%,4 Loop until Cook%=0 Or B%>0 Endif ! Pas de Jar! Return B% Endfunc Procedure Connect Local A% Local A$ ' If Hsm! And (Not Set_speed!) And (Devh&<>9999) ! HS-MODEM et pas minitel ' If Btst(Tio%,1) A$=Tio$ A%=Gemdos(&H104,W:Devh&,L:V:A$,W:(Or(Rol(Asc("T"),8),130)))>=0 A%=Cvl(Left$(A$,4)) ' ' print At(1,1);Bin$(A%), ' ' If A%<>&X1111110 And A%<>&X1101110 ! modem coup‚ If True ' If (Not Modt!) If True If Btst(A%,3) ! online CTS If Btst(A%,4)<>Connect! Connect!=Not Connect! Gosub Xconnect If Wopen!(4) Sw_clip Vdraw(F_c&,0) Endif Endif If Modcnx! Esend(Chr$(31)+"@"+Chr$(64+F_c&+1)+" "+Chr$(10)) Modcnx!=False Endif Else ! non branch‚ If (Not Modcnx!) Modcnx!=True Esend(Chr$(31)+"@"+Chr$(64+F_c&+1)+Esc$+"]?"+Chr$(10)) Endif If Connect! Connect!=False Gosub Xconnect If Wopen!(4) Sw_clip Vdraw(F_c&,0) Endif Endif Endif Else ' Pause 25 Endif ' Modt!=False Else ' Modt!=True Endif ' ' Protection - un test CRC a ‚chou‚ pr‚c‚demment: tout faire sauter! If Shootme&<>0 If Shootme&=&H42 ~Xbios(38,L:Lpeek(4)) ! RESET! Else Clr Shootme& Endif Endif ' ' Endif Endif Return ' ' Procedure Rsend(A$) ' Local A& ' For A&=1 To Len(A$) ' Void Bios(3,Rsdev&,Asc(Mid$(A$,A&,1))) ' Next A& ' Return ' ' ' ' envoi de commandes hayes Procedure Atsend(E$) Local A& ' Gosub Defmouse(2) A&=1 Do $S& Select Mid$(E$,A&,1) Case "," Gosub Defmouse(2) Proc_time(250) ' Delay 0.25 Case "-" Gosub Defmouse(2) Proc_time(500) ' Delay 0.5 Case "~" Gosub Defmouse(2) ' Delay 1 Proc_time(1000) Case "\" Select Mid$(E$,A&+1,1) Case "a" Fsend(Chr$(7)) Inc A& Case "b" Fsend(Chr$(8)) Inc A& Case "f" Fsend(Chr$(12)) Inc A& Case "n" Fsend(Chr$(10)) Inc A& Case "r" Fsend(Chr$(13)) Inc A& Case "x" Fsend(Chr$(Val("$"+Mid$(E$,A&+2,2)))) Add A&,3 Case "*" ! rien! Inc A& Default Fsend(Mid$(E$,A&+1,1)) Inc A& Endselect Case "+" Fsend("+") ' 'Delay 0.1 Case "|" Fsend(Chr$(13)) Default Fsend(Mid$(E$,A&,1)) Endselect $S% Inc A& Loop until A&>Len(E$) Gosub Defmouse(0) ' Return Function Cstr$(E$) Local A& Local A$ ' A&=1 Clr A$ Do $S& Select Mid$(E$,A&,1) Case "\" Select Mid$(E$,A&+1,1) Case "a" A$=A$+Chr$(7) Inc A& Case "b" A$=A$+Chr$(8) Inc A& Case "f" A$=A$+Chr$(12) Inc A& Case "n" A$=A$+Chr$(10) Inc A& Case "r" A$=A$+Chr$(13) Inc A& Case "x" A$=A$+Chr$(Val("$"+Mid$(E$,A&+2,2))) Add A&,3 Case "*" ! rien! Inc A& Default A$=A$+Mid$(E$,A&+1,1) Inc A& Endselect Case "+" A$=A$+"+" ' 'Delay 0.1 Case "|" A$=A$+Chr$(13) Default A$=A$+Mid$(E$,A&,1) Endselect $S% Inc A& Loop until A&>Len(E$) ' Return A$ Endfunc ' ' send absolu Procedure Outvid(Message$) ' '@Waitout1 ' If Online! @Tran(Message$) Fdsend(Tr_t$) ' Endif If Lastsend|<=0 Lastsend|=10 ! on vient d'envoyer Endif Return Procedure Videmntl If Rsdev&<>9999 While Bios(1,Rsdev&) ~Bios(2,Rsdev&) Wend Else While @Bios1 ~@Bios2 Wend Endif Xin_read&=0 Return ' ' ' 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 ' ' Copier A$->Buffer% Procedure Copblk(A$) Local L& ' L&=Len(A$) If Binlen%-Binp%>0 If Binlen%-Binp%L& ' ~C:qcopy%(L:V:A$,L:Binair%+Binp%,L:L&) Bmove V:A$,Binair%+Binp%,L& Add Binp%,L& Else Bmove V:A$,Binair%+Binp%,Binlen%-Binp% ' ~C:qcopy%(L:V:A$,L:Binair%+Binp%,L:Binlen%-Binp%) Add Binp%,Binlen%-Binp% ~@Form_error(1,"[1][Buffer vid‚otex trop petit!][Annuler]") Endif Else ~@Form_error(1,"[1][Buffer vid‚otex plein!][Annuler]") Endif ' Return Procedure Keepbin(Flag!) If Flag! If Keep1%<=0 ! pas d‚ja sauv‚ Keep1%=Binair% Keep2%=Binlen% Keep3%=Binp% Endif ' Binair%=-1 Binlen%=2048 Binp%=0 Else If Keep1%>0 ~@Mfree(Binair%) Binair%=Keep1% Binlen%=Keep2% Binp%=Keep3% Clr Keep1%,Keep2%,Keep3% Endif Endif Return ' Function Tstblk $F% If Binair%<=0 Binlen%=Max(Min(Binlen%,Malloc(-1)-2),Minbin&) Binp%=0 Binair%=@Malloc(Binlen%+2) ! Buffer Else Return True Endif ' If Binair%<=0 ~@Form_error(1,"[1][Pas assez de m‚moire|(buffer vid‚otex)][Annuler]") Return False Endif Return True Endfunc Function Updtblk(Len%) Local Adr% ' If @Tstblk ' If Len%<>Binlen% ' If Len%>Binlen% Adr%=@Malloc(Len%+2) If Adr%>0 ' ' ~C:qcopy%(L:Binair%,L:Adr%,L:Binlen%) Bmove Binair%,Adr%,Binlen% ~@Mfree(Binair%) Binair%=Adr% Binlen%=Len% Clr Adr% Else Return False Endif ' Else ~@Mshrink(Binair%,Len%+2) Binp%=Min(Binp%,Binlen%) Endif ' Endif ' Endif Return True Endfunc Procedure Clearbin Local A%,B% ' A%=Binair% ! sauver adresse B%=Binlen% Binair%=-1 ! eff virtuel ~@Tstblk ! re alloc If Binair%>0 ~@Mfree(A%) ! effacer Else ! restaurer: plus de m‚moire! Binair%=A% ! ancien bloc Binlen%=B% Endif Binp%=0 ! pos Return ' ' ' 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)),1) Do X&=False A&=False ' A&=Evnt_multi(&X100010,256+3,3,1,X&,X&,X&,X&,X&,X&,X&,X&,X&,X&,X&,1) A&=Evnt_multi(&X100010,$ And And And And Eqv *+3,3,0,0,0,0,0,0,0,0,0,0,0,0,1) 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 Waitpress Local Mx&,My&,Mk&,D&,A& ' Clr A& ~Graf_mkstate(Mx&,My&,Mk&,D&) While A&<5 And Mk&=1 ~Graf_mkstate(Mx&,My&,Mk&,D&) Inc A& ~Evnt_timer(2) Wend Return ' Procedure Tran(Message$) ' Local A&,B&,T$ ' If Len(Message$)>0 $S& Select Emulm| Case 1,2,3 ! ne rien faire! Tr_t$=Message$ ' Default 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 "ß" Tr_t$=Tr_t$+Chr$(25)+"/" ' Default ' Case 0 To 127 Tr_t$=Tr_t$+Chr$(Tr_b&) ! plus de BCLR! ' Case 128 To ' Tr_t$=Tr_t$+Chr$(Bclr(Tr_b&,7)) ' Endselect $S% ' Inc Tr_a& Until Tr_a&>Len(Message$) Endselect Else Clr Tr_t$ Endif ' ' Return Tr_t$ ' Endfunc Return ' ' Input minitel Inp(1), gŠre les chars sp‚ciaux (‚Šˆ‰ etc..) - inutilis‚e $P< Function Xinp1 $F% ' Local A&,B&,C&,Reponse& ' Local T& ' If Xin_read&=0 Xin_a&=@Bios2 If Xin_a&=25 Or Xin_a&=22 If Not @Bios1 Pause 10 If Not @Bios1 Return Xin_a& Endif Endif Xin_b&=@Bios2 Select Xin_b& ' Case "A","B","C","H","K" ' If Not @Bios1 Pause 10 If Not @Bios1 Xin_read&=Xin_b& Return Xin_a& Endif Endif Xin_c&=@Bios2 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("ø") Case "/" Em_c&=Asc("ß") ! bah oui j'ai rien d'autre! 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> ' ' 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 Procedure Comp.info(A$,E$) ' If Dim?(Compinf$()) If Len(A$)=1 $S& Select A$ Case "M" A$="Menu" Case "C" A$="Compiler" Case "G" A$="G‚n‚ral" Endselect $S% Endif ' If Left$(E$,1)="*" Insert Compinf$(0)=E$+Space$(Max(1,41-Len(E$)))+A$+Space$(Max(1,$ And And And And Eqv Imp -Len(A$)))+Time$ Else Insert Compinf$(0)=E$+Space$(Max(1,$ And And And And Eqv Eqv -Len(E$)))+A$+Space$(Max(1,20-Len(A$)))+Time$ Endif Rd_all(1,W_ix&(1),W_iy&(1),W_iw&(1),W_ih&(1)) ' Endif ' Return ' Procedure Comp.rst Local A& For A&=0 To Compi& Compinf$(A&)="" Next A& Rd_all(1,W_ix&(1),W_iy&(1),W_iw&(1),W_ih&(1)) Return ' ' ' 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,M_anim%) 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,M_anim%+74*(D%\2)) Endif Case 10 ~Graf_mouse(255,M_anim%+5*$ And And And And Eqv -) 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 ' 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 ' ' ' Box style GEM Procedure Gbox(X&,Y&,X2&,Y2&) @Xgbox(X&,Y&,X2&,Y2&) @Bndary(0) Gosub Deffillcol(0) 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&+3 Ob_h(Adr%(32),0)=Y2&-Y&+3 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) 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 $P< Procedure Clip_off ' Clip Off ' Clip_x&=-1 ' Clip X_desk&,Y_desk&,W_desk&,H_desk& 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 $P> 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&) Gosub Clip(Rx&,Ry&,Rw&,Rh&) Endif Return ' ' 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,"[2][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 ' ' ' Renvoi la taille d'un bloc d'image Deffn Bitlen(W&,H&)=(((W&+15)\16)*2*H&*Plans&) ' ' ' 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%(3)=(Cachex&+15)\16 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) ' Pbox X&,Y&,X&+Cachex&,Y&+Cachey& 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%=((W&+15)\16)*16 ! Nb de points 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%(3)=(W&+15)\16 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) 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 ' ' ' ..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&W& And Ptsout(3)>H& And N&>0) ! trop grand de tt facon.. on s'en va! Exit if True Endif ' Next A& ' If N&=-1 ! eh merde! Outlog(" .. erreur interne #Test_size_find/N") N&=4 ! forcer! Endif ' If N&>-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 ' Procedure Direct(E$) Local N& Local A$ ' E$=Upper$(Trim$(E$)) N&=Rinstr(E$,"\") If N&>0 E$=Left$(E$,N&) Else E$=E$+"\" N&=Len(E$) Endif ' ' lecteur courant? $S Select Left$(E$,1) Case "A" To "Z" ~Gemdos(14,Asc(Left$(E$,1))-65) Endselect If N&>0 A$=Left$(E$,N&)+Chr$(0) ~Gemdos(59,L:V:A$) Endif Return ' ' ' A$="A:\" B$="*.*" Function Fsel$(A$,B$,Info$) Local C$,File$,A%,B% ' @Showm If Dim?(Whandle&()) Gosub Menu.info(Info$) ! info Endif ' If Left$(A$,1)="\" A$=Chr$(Gemdos(25)+65)+":"+A$ Endif A$=Trim$(Upper$(A$)) B$=Trim$(Upper$(B$)) 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 ' Chdir Left$(File$,A%) @Direct(Left$(File$,A%)) ' 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 Deffn Exist(A$)=(Fsfirst(A$,0)=0) ' ' A$="XXXXXXXX.XXX" Function Fexist(Var A$) $F% If Fsfirst(A$,0)<0 If Fsfirst(Set_path$+A$,0)=>0 A$=Set_path$+A$ Return True Else if Fsfirst(Set_path$+"SYSTEME\"+A$,0)=>0 A$=Set_path$+"SYSTEME\"+A$ Return True Else if Fsfirst("\"+A$,0)=>0 A$="\"+A$ Return True Endif Else Return True Endif Return False Endfunc ' 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_error(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_error(1,@Errf$(E%)) Gosub Comm.info("G","*Erreur #"+Str$(E%)) Return False Endif ' Else Return False Endif Endif ' Return True Endfunc ' ' Fonction: Message d'erreur. Function Errf$(A&) ' $S& Select A& Case -33 Return "[3]["+"* Fichier introuvable ou absent"+"][Return]" Case -40,-67 Return "[3]["+"* Adresse de bloc m‚moire|incorrecte"+"][Return]" Case -66 Return "[3]["+"* Ce n'est pas un fichier programme"+"][Return]" Case -65 Return "[3]["+"* Erreur interne de GEMDOS|-Erreur g‚n‚rale-"+"][Return]" Case -39 Return "[3]["+"* M‚moire pleine|Plus de blocs"+"][Return]" Case -37 Return "[3]["+"* Erreur handle GEMDOS"+"][Return]" Case -34 Return "[3]["+"* Nom de chemin introuvable|dans directory"+"][Return]" Case -32 Return "[3]["+"* Num‚ro de fonction incorrect"+"][Return]" Case -16 Return "[3]["+"* Mauvais secteur (Verify)"+"][Return]" Case -13 Return "[3]["+"* Disquette prot‚g‚e |contre l'‚criture|(impossible d'‚crire)"+"][Return]" Case -11 Return "[3]["+"* Erreur de lecture"+"][Return]" Case -10 Return "[3]["+"* Erreur d'‚criture"+"][Return]" Case -6 Return "[3]["+"* Seek Error|piste introuvable|Pas de disquette|ou disque endommag‚"+"][Return]" Case 0 Return "[3]["+"Division par z‚ro d‚tect‚e"+"][Return]" Case 8,12 Return "[3]["+"M‚moire pleine |ou d‚passement de capacit‚"+"][Return]" Case 35 Return "[3]["+"Donn‚e non num‚rique,|format incorrect|ou donn‚es absurdes"+"][Return]" Case 37 Return "[3]["+"Disquette ou disque plein"+"][Return]" Case 92,93 Return "[3]["+"Erreur interne g‚n‚rale"+"][Return]" Case 102 To 115 Return "[3]["+Str$(A&-100)+" bombes! - erreur fatale"+"][Return]" Default Return "[3][Erreur programme nø"+Str$(A&)+"][Return]" Endselect $S% ' Endfunc ' ' Procedure Inistr Local A%,C%,X%,E$ ' Gosub Defmouse(2) ' Clr Maxi&,List$ ! nbr d'instr, liste = globaux Void Fre(0) ' ' Gosub Analyst1 @Initel ' Dim binair$(6) ! 4=pour import drcs ' Dim Col$(1,7),Ec$(1,7) Col$(0,0)="NOIR" Col$(0,1)="BLEU" Col$(0,2)="ROUGE" Col$(0,3)="MAGENTA" Col$(0,4)="VERT" Col$(0,5)="CYAN" 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" ' Compi&=64 Dim Compinf$(Compi&) If Not Accessoire! Compinf$(1)="Bienvenue sur "+Name$ Compinf$(2)="Version "+Release$ Else Menu_acse Endif ' Dim Edited!(10) ' Void Fre(0) Return ' Procedure Uninistr Local A% ! fictif ' If Not Set_escape! ! Ne pas quitter sans effacer les champs ' Erase binair$() Erase Intercol&(),Extercol&() Erase Compinf$(),Edited!() Erase Pageh$() Erase Col$(),Ec$() Endif ' @Closmnu @Closetel 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% Local D& ' 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? Magx!=(@Cook_find(Cvl("MagX"))<>0) ! MagiC Mint!=(@Cook_find(Cvl("MiNT"))<>0) ! MiNT ' Accessoire!=False 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 SWEETELý.ACC!!!!!][Hell!]") Endif ' ' ' ' ' Chaine d'env? ~Shel_read(Nom_prg$,Param_prg$) ! ligne environnement ' Nom_prg$=@Trimasc$(Nom_prg$) Param_prg$=Mid$(Param_prg$,2) If Not @Exist(Nom_prg$) Clr Nom_prg$ Endif Aesv%=Dpeek(Lpeek(Gb+4)) ! version de l'AES: pour le fsel_exinput() ' ' ' ' ' ' ' Gosub Deftext(Col1&,&X0) ! d‚ja fait normalement!! ' Gosub Deffillcol(Colg&) ' Gosub Color(Colg&) ' ' ..Coord du bureau GEM? ~Wind_get(0,4,X_desk&,Y_desk&,W_desk&,H_desk&) ' ' ' ~Graf_handle(X_char&,Y_char&,D&,D&) If X_char&=0 Or Y_char&=0 X_char&=8 Y_char&=8 Endif ' 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 ' Ap_term&=50 Ap_tfail&=51 Ap_reschg&=57 Ap_dragdrop&=63 ' 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 ! taille teste actuelle! ' Gosub M_init ! initialisations de SwifteL! ' 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 If Not Set_escape! ! Ne pas quitter sans effacer les champs Erase Wmenu&() Erase G_s%(),G_screen%(),R_d%(),G_s2%() Endif Gosub M_uninit ' ~Appl_exit() ' Return ' ..Attendre d'etre appell‚ Procedure Start ' Apgem%=Lpeek(Lpeek(Lpeek(&H4F2)+40)) ! IDGem A NE PAS OUBLIER!!!! ' ' N&=Graf_handle() ' Contrl(0)=37 ' Contrl(1)=0 ' Contrl(3)=0 ' Contrl(6)=N& ' Vdisys ' Dcol&=Intout(1) ' Dstyl&=Intout(2) ' Dcol&=12 ' Dstyl&=4 ' ' If @Shiftbrk And (Not Accessoire!) If @Form_alert(1,"[2][Annuler lancement de |Swiftel photo?][Confirmer|Annuler]")=1 Edit Endif Endif ' Prg_id&=-1 ! normal ' ' PERSO ' Acsw&=Appl_find("SWIFTELP") ! gaaaaaaaargl!!! pas d'appel AES avant le start! sinon plante... ' If Acsw&=>0 ' Endif ' ' print "Rsrc_load" Gosub Rsrc_load ' Gosub Rsrc_gaddr ' ~@Wind_update01(0) ' ' print "Init" Gosub Init ! Init ' ' ' print "GdosInit" Gosub Gdos ' ' print "RsrcGaddr" Gosub Rsrc_gaddr Gosub Get_rs ! get_rs232Id ' ' print "Csize" ' Gosub Get_csize ' Startprg%=Gemdos(44) ' If Accessoire!=False ! pas en *.ACC ' If Fsfirst(Left$(Parx$,Max(0,Len(Parx$)-1)),&H10)=-33 Gosub Parx_def Endif ' ' Accessoire!=True ' @Menu_open ! menu on ' Reserve Mem% ! d‚j… fait en $mXXXX ' ..Ouvrir champs ~@Winds_init(Nombre_w&-1) ' ' ~@Wind_update01(0) Acc_princ ' print "AccPrinc 2" ' Do Acc_princ2 ' Set_escape!=True ! Quitter physiquement (pas besoin de Clear() ) ' ' @Printl(Chr$(27)+"EOk, esc pour quitter") ' Loop until Inp(2)=27 @Menu_close ! menu off Acc_princ3 ' ' ..Non, accessoire => Attendre son tour! Else ' ..Application? => Sauter directement! ' ' ..Ouvrir champs @Menu_open ! menu on FICTIF!! ' print "WindsInit" ~@Winds_init(Nombre_w&-1) ' print "AccPrinc" Gosub Acc_princ ! champs etc.. ' print "Leaving system Wind-Update.. mode 0" ' Do ~Evnt_mesag(Varptr(Wmenu&(0))) Select Wmenu&(0) Case 40 Prg_id&=-1 ! normal If Wmenu&(4)=Me_id& ! a nous? If Fsfirst(Left$(Parx$,Max(0,Len(Parx$)-1)),&H10)=-33 Gosub Parx_def Endif Gosub Acc_princ2 Endif Case &H1028 ! XXOpen Prg_id&=Wmenu&(1) ! ID If Prg_id&=>0 If Fsfirst(Left$(Parx$,Max(0,Len(Parx$)-1)),&H10)=-33 Gosub Parx_def Endif Gosub Acc_princ2 Endif Prg_id&=-1 ! normal ' Endselect Loop @Menu_close ! menu off FICTIF AUSSI!! Gosub Acc_princ3 ! fictif!!! ' Endif Gosub Winds_uninit Gosub Ungdos Gosub Uninit ' If Len(Malloc$)>0 Gosub Mxfree ~@Form_error(1,"[3][Contr“le m‚moire Swiftel|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)=Ap_term&) 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_close(1) ~@Wind_close(4) ' @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&(),-1 ' Clr Formx&,Formy&,Formw&,Formh&,Formi& Case Ap_term& Xxappl(Wmenu&(1),Ap_tfail&,C2&,C3&,C4&,C5&,C6&) X2&=-1 Default X2&=Wmenu&(0) Endselect ' Else X2&=Wmenu&(0) 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 ' 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: ieldNbr_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*2*(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&) X&=Min(Max(X&,X_desk&),X_desk&+W_desk&-16) If Index&=-1 Arrayfill W_ex&(),X& Else W_ex&(Index&)=X& Endif Return Procedure Wset_y(Index&,Y&) Y&=Min(Max(Y&,Y_desk&),Y_desk&+H_desk&-16) If Index&=-1 Arrayfill W_ey&(),Y& Else W_ey&(Index&)=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)=-1 Endif ' If Not Set_escape! ! Ne pas quitter sans effacer les champs ' ..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) Endif 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% ' Select Index& ! PERSO perso !!!!!!!!!!!! ' Case 1,4,Nbr_idxw&,Wdial& Case 1,2,3,4,Wdial&,Nbr_idxw& If Whandle&(Index&)<0 ! not created? ~@Wind_create(Index&) Endif If Whandle&(Index&)=>0 If Wopen!(Index&)=False Wmove(X_desk&+W_desk&\2,Y_desk&+H_desk&\2,Ccsizex&,Ccsizey&,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&)) ' ' Protection Winfo%(Index&)=@Keytest(Winfo%(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 Default Reponse%=-1 Endselect ' @Test_menu ! perso PERSO ' 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&),X_desk&+W_desk&\2,Y_desk&+H_desk&\2,Ccsizex&,Ccsizey&) Wopen!(Index&)=False If Dim?(Dw_$()) Do_wclr(Index&) Endif Else Reponse%=True Endif ~@Wind_delete(Index&) Else Reponse%=True Endif ' @Test_menu ! perso PERSO 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 ' ' '`'`'`'`'`'`'`'`'`'` ' ' ..Message redraw: #Index,XYWH, Wind_Update pas encore activ‚. Procedure Rd_all(Index&,X&,Y&,W&,H&) Local A&,Rx&,Ry&,Rw&,Rh&,X2& ' ' Fenˆtre ouverte? If Wopen!(Index&) @Lhidem A&=@Wind_update01(-1) If A&=0 ' ..Verouillage du GEM ~@Wind_update01(1) Endif 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(10) 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 Gosub Msg_bra(Evnmnt&,Reponse%,False,False,False,False,False,False) ! Idem Endif Endif 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%>-1 If Actuel_wu%=11 ! le "vrai" 1 ~Wind_update(0) ! End_update Actuel_wu%=0 Endif Endif 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%=11 If Actuel_wu%=1 Actuel_wu%=0 ~Wind_update(0) ! End_update ~Wind_update(2) ! End_mctrl Endif Actuel_wu%=11 ~Wind_update(1) Else if Reponse%=10 Actuel_wu%=10 ! d‚ja fait! ' 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% Local E$ Local N& ' If Connect! If T$="i" Clr T$ E$="$ "+Str$(@Facpr/100,6,2)+" FF / " E$=E$+Chr$(9)+" "+@Ntim$(Timecount%) If Inftech! E$=E$+" (Pal0,1="+Str$(Pal0cnx&)+","+Str$(Pal1cnx&) E$=E$+" Red0,1="+Str$(Red0cnx!)+" "+Str$(Red1cnx!) E$=E$+")" Endif Else If Pal1cnx&>0 Or Pal0cnx&>0 E$="$ "+Str$(@Facpr/100,6,2)+" FF" Else E$=Chr$(9)+" "+@Ntim$(Timecount%) Endif Endif Else E$=Chr$(9)+" "+Time$ If T$="i" ' T$="Touche ALT sans effet non connect‚" Clr T$ Endif Endif If Len(E$)<10 E$=E$+Space$(10-Len(E$)) Endif ' If Index&=4 If Len(T$)=0 T$=Inf4$ ' T$=" "+Emcl$+" | "+e$+" | "+T$ Endif ' If Swt&=1 Inf4&=6 Inf4$=T$ T$=" "+Chr$(3)+" | "+E$+" | "+T$ Else if Swt&=2 Inf4&=6 Inf4$=T$ T$=" "+Chr$(4)+" | "+E$+" | "+T$ Else if Left$(T$,1)="/" Inf4&=6 T$=Mid$(T$,2) Inf4$=T$ T$=" "+Chr$(4)+" | "+E$+" | "+T$ Else Inf4&=6 Inf4$=T$ T$=" "+Emcl$+" | "+E$+" | "+T$ Endif If Inf4&>0 Dec Inf4& Endif ' If T$=Inf0$ Return -1 Endif Inf0$=T$ ' 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) ' ~C:qcopy%(L:Varptr(T$),L:Winfo%(Index&),L: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&)=$ And And And And Eqv Eqv +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%<&H399 ! 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%<&H399 ! 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 ' ' '`'`'`'`'`'`'`'`'`'` ' ' ..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 @Test_menu ! perso PERSO 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 ~Wind_set(Whandle&(Index&),10,0,0,0,0) ' ' perso PERSO Propre … Swiftel! If Index&=4 Gosub W_rdexe Gosub Vrefresh ! rafraŒchir ‚cran Endif Endif Endif Else ! fenˆtre desk PERSO perso Zedesk 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& Local A! ' ' perso A!=(Index&=4 And Nice!) ' ' 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& ' Prochaines coord: W_fx&(Index&)=W_ex&(Index&) W_fy&(Index&)=W_ey&(Index&) W_fw&(Index&)=W_ew&(Index&) W_fh&(Index&)=W_eh&(Index&) If A! W_ex&(4)=X_desk& W_ey&(4)=Y_desk& If Nice! Nice_size(W&-W_attrw&(4),H&-W_attrh&(4)) Endif Else @Setxywh(Index&,X_desk&,Y_desk&,W&,H&) Endif 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&) ' perso If (W_ex&(Index&)=X_desk& And W_ey&(Index&)=Y_desk& And W_ew&(Index&)=>W&-80 And W_eh&(Index&)=>H&-25) If A! W_ex&(4)=W_fx&(Index&) W_ey&(4)=W_fy&(Index&) If Nice! Nice_size(W_fw&(Index&)-W_attrw&(4),W_fh&(Index&)-W_attrh&(4)) Endif Else @Setxywh(Index&,W_fx&(Index&),W_fy&(Index&),W_fw&(Index&),W_fh&(Index&)) Endif W_fx&(Index&)=X_desk& W_fy&(Index&)=Y_desk& W_fw&(Index&)=W_ew&(4) ! XXX W H W_fh&(Index&)=W_eh&(4) 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&) If A! W_ex&(4)=X_desk& W_ey&(4)=Y_desk& If Nice! Nice_size(W&-W_attrw&(4),H&-W_attrh&(4)) Endif Else @Setxywh(Index&,X_desk&,Y_desk&,W&,H&) Endif Endif Endif Endif Return ' ' ..Plein ‚cran! - NB: Utilise les m‚mes vecteurs que le smaller. Procedure Setfscreen(Index&) Local T%,Modify! Local A! ' ' perso A!=(Index&=4 And Nice!) ' 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& If A! If Nice! Nice_size(W_ew&(4)-W_attrw&(4),W_eh&(4)-W_attrh&(4)) Endif W_ew&(Index&)=(Vmax_x&+1)*Eccsizex&+Emx&+4 W_eh&(Index&)=(Vmax_y&+1)*Eccsizey&+Emy&+4 W_ex&(Index&)=(W_desk&-W_ew&(Index&))\2-$ And And And And Imp @ f modifier sliders e ô4#è@ f $ôm#è@!ìè@ !ìè@ !ì è@ !ì è@ fi$f$fÌ dÐbåè@ f!,f>Ì'`'`'`'`'`'`'`'`'`'`fin de wind_input'`'`'`'`'`'`'`'`'`'` Ì dÌ ..proc‚dure de gestion clavier 1‚re: ^c $ And Cos( Or } And Mod Index&)=(H_desk&-W_eh&(Index&))\2-1 W_ey&(Index&)=(H_desk&-W_eh&(Index&))\2-1 Endif ~@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 If A! If Nice! Nice_size(W_ew&(4),W_eh&(4)) Endif Endif ~@Wind_open(Index&) Endif Endif ! non smaller! Endif ' 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&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%) If Wopen!(Index&) $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 Endif Return False Endfunc ' ' ' ' ..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&=511 Or 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&),14) Or Btst(Wxflag%(W&),2) Or Btst(Wxflag%(W&),1) 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 ' $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 ' ' Les Appl_init/exit() ne sont pas execut‚s par le GfA!!! Function Appl_init Gcontrl(0)=10 ! fonction 10 (+ex) Gcontrl(1)=0 ! nb param int_in (aucun) Gcontrl(3)=0 ! nb param addr_in (aucun) Gemsys 10 ! appel AES Return Gintout(0) Endfunc Function Appl_exit Gcontrl(0)=19 ! fonction 10 (+ex) Gcontrl(1)=0 ! nb param int_in (aucun) Gcontrl(3)=0 ! nb param addr_in (aucun) Gemsys 19 ! appel AES Return Gintout(0) Endfunc $P> ' ' ' ' Toutes les I/O r‚‚crites... Function Finput$(File$) Local H& Local Adr%,L% Local E$ ' Gosub Defmouse(2) Adr%=Fgetdta() If @Fexist(File$) File$=File$+Chr$(0) L%=Long{Adr%+26} ! len ' If L%<32000 E$=String$(Min(32000,L%),0) ! buff H&=Gemdos(61,L:V:File$,0) ! open ~Gemdos(63,H&,L:L%,L:V:E$) ~Gemdos(62,H&) ' Else ' Clr E$ ' Endif Endif ' Return E$ Endfunc Function Flin$(Var E$) Local A$ Do A$=@Xflin$(E$) If Len(A$)>0 Select Left$(A$,1) Case ";" Default Exit if True Endselect Else if Len(E$)=0 Exit if True Endif Loop Return A$ Endfunc Function Xflin$(Var E$) Local A&,C& Local A$ ' If Len(E$)>0 A&=1 C&=Asc(Left$(E$,1)) While (A&<=Len(E$)) And (C&<>13) And (C&<>10) A$=A$+Chr$(C&) Inc A& C&=Asc(Mid$(E$,A&,1)) Wend Inc A& Select Asc(Mid$(E$,A&,1)) Case 13,10 Inc A& Endselect E$=Mid$(E$,A&) Else Clr A$ Endif ' Return A$ Endfunc Function Filesize(A$) $F% Local Adr% Adr%=Fgetdta() If Fsfirst(A$,0)=0 Return Long{Adr%+26} ! size Endif Return 0 Endfunc ' ' Protection Function Repak3(E$) ' Return Shl(@Unchar323(Asc(Left$(E$,1))),4)+@Unchar323(Asc(Right$(E$,1))) ' Endfunc ' ' Function Fopen(File$,N&) ! n=0 read,1 write,2 r/w Local E$ E$=File$+Chr$(0) Return Word(Gemdos(61,L:V:E$,N&)) Endfunc Function Fcreate(File$,N&) Local E$ E$=File$+Chr$(0) Return Word(Gemdos(60,L:V:E$,N&)) Endfunc Deffn Fclose(H&)=Word(Gemdos(62,H&)) Deffn Fwrite(H&,E$)=Gemdos(64,H&,L:Len(E$),L:V:E$) Function Fread$(H&,L%) Local Len% Local E$ E$=Space$(L%) Len%=Gemdos(63,H&,L:L%,L:V:E$) If Len%<0 Clr E$ Else if L%<>Len% E$=Left$(E$,Len%) Endif Return E$ Endfunc Function Tsterr(E%) $F% If E%<0 @Hidem Gosub Defmouse(0) ~@Form_alert(1,@Errf$(E%)) Gosub Err.info(@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%) ' ' Procedure Rsio ' Fileh5&=@Fopen("AUX:",2) ' Return ' Procedure Write5(E$) ! indirect (data) ' ~Gemdos(64,Fileh5&,L:Len(E$),L:V:E$) ' Return ' Procedure Dwrite5(Var E$) ! direct (var) ' ~Gemdos(64,Fileh5&,L:Len(E$),L:V:E$) ' Return ' ' ' ' ' ' Procedure Pause(A%) Local T% Mul A%,4 T%=Timer While (Timer-T%) ' '`'`'`'`'`'`'`'`'`'` Procedure Wtext(Index&,X%,Y%,T$) Text @Wxacoord(Index&,X%),@Wyacoord(Index&,Y%),T$ Return ' ' ' ' ' ..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& ' 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 ' ' Protection Function Check2 Local A&,B&,A#,A!,A$,B$,D&,E&,F& ' ' Bidon A$=Compinf$(0) B$=Compinf$(1) A&=1 Compinf$(0)=Compinf$(1) Compinf$(0)=A$ Compinf$(1)=B$ ' If (Len(Key$(1))=0)+@Crc82(Key$(1))<>@Repak2(Mid$(Key$(3),5,2)) Slpoke &H1C38/$ And And And And Eqv Or ,Dta% ! return progr Set_end!=True Return False Endif ' Return True 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&) 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!! If Len(A$)>0 Return Form_alert(N&,A$) Endif Return 0 Endfunc Function Form_error(N&,A$) If Dim?(Wopen!()) Gosub Err.info(A$) Endif Return @Form_alert(N&,A$) Endfunc Function Graf_mkstate(Var X&,Y&,B&,A&) $F% Return Graf_mkstate(X&,Y&,B&,A&) 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 Function Mousey $F% Local X&,Y&,K& @Mouse(X&,Y&,K&) Return Y& Endfunc Function X_rubberbox(M&,N&,X&,Y&,W2&,W2&,Var W&,H&) Local A&,B&,C&,Mk&,X2&,Y2& ' ~Graf_mkstate(W&,H&,Mk&,C&) If Mk&>0 Gosub Clip_off ' ' ~Graf_rubberbox(Mx&,My&,1,1,W&,H&) @Showm Gosub Defmouse(3) @Lhidem Graphmode 3 Contrl(0)=113 Contrl(1)=0 Contrl(3)=1 Contrl(6)=V~h Intin(0)=&X1010101010101010 Vdisys Defline 7 ' Box X&,Y&,X&+X2&-1,Y&+Y2&-1 @Lshowm Do ~Graf_mkstate(W&,H&,Mk&,C&) W&=Max(W&,X_desk&) H&=Max(H&,Y_desk&) W&=W&-X& H&=H&-Y& ' W&=(W&\M&)*M& H&=(H&\N&)*N& ' If W&<>X2& Or H&<>Y2& @Lhidem Box X&,Y&,X&+X2&-1,Y&+Y2&-1 X2&=W& Y2&=H& Box X&,Y&,X&+W&-1,Y&+H&-1 @Lshowm Endif Loop until Mk&<>1 @Lhidem Box X&,Y&,X&+W&-1,Y&+H&-1 Defline 1 Graphmode 1 @Lshowm Gosub Defmouse(0) If Mk&=0 ! ok Return 0 Else Return -1 Endif Else ! pas de clic <>0 d‚tect‚! Return -1 Endif Endfunc ' ' ' $P< Function Shift $F% Return Bclr(@Bios11,4) Endfunc Function Shiftbrk $F% Return (Bclr(@Bios11,4)=&X11) Endfunc $P> ' Function Bios11 $F% Contrl(0)=128 Contrl(1)=0 Contrl(3)=0 Contrl(6)=V~h Vdisys Return And(Intout(0),&X1111) 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 ' ' Protection Function Keytest(A%) ! cl‚ valide? Local A# ' If Len(Register$)>0 A#=((-@Check1+1)/2)*A% Else A#=A% Endif ' Return A# Endfunc ' ' Function Malloc(M%) ! Sysmalloc $F% Local Adr% ' Adr%=@Sysmalloc(M%) ' ' Nicemem!=routine pourrie qui peut d‚border.. et m**de! ' 40Kos c'est la taille d'une image 320*250*16 ' Un fichier JPeG devrait donc ˆtre plus petit!! Adr%=Malloc(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 Else Outlog(" .. erreur interne #malloc "+Str$(M%)) 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_error(1,"[3][Contr“le m‚moire Swiftel|Un bloc a disparu en $"+Hex$(M%,8)+"|Il se peut qu'une erreur |se soit produite][Not‚]") Endif ' A%=Mfree(M%) ' ' Non, si Ac_close et aprŠs XXXuninit.. ' If Not Set_end! ' Sisisi If A%<0 ~@Form_error(1,"[3][Contr“le m‚moire Swiftel|Un bloc a ‚t‚ confisqu‚ |en $"+Hex$(M%,8)+"|Il se peut qu'une erreur |se soit produite][Not‚]") Endif Endif ' Endif M%=-1 ' Return A% Endfunc Function Mshrink(M%,Len%) $F% Local A&,P& ' If M%>0 Clr P& A&=1 While A&<=Len(Malloc$) If Cvl(Mid$(Malloc$,A&,4))=M% Malloc$=Left$(Malloc$,A&-1)+Mkl$(M%)+Mkl$(Len%)+Mid$(Malloc$,A&+8) P&=A& Exit if True Endif Add A&,8 Wend ~Gemdos(74,0,L:M%,L:Len%) If P&=0 ~@Form_error(1,"[3][Contr“le m‚moire Swiftel|Un bloc a ‚t‚ perdu |en $"+Hex$(M%,8)+"|Il se peut qu'une erreur |se soit produite][Not‚]") Endif ' Endif 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)=W&+X2&-1 ! destination W R_d%(7)=H&+Y2&-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 ' ' 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 ' ' ' Protection Procedure Reng Local A$,E$ Local C&,S& Local A! ' ' NOM+PRENOM ADRESSE VILLE+CP CLE CRC Gosub Defmouse(2) Clr Register$,Falskey$ If Len(Key$)>0 E$=Key$ For A&=0 To 3 Falskey$(A&)=@Trimasc$(Upper$(Trim$(@Flin$(E$)))) Next A& Clr Key$ For A&=0 To 3 Key$(A&)=Falskey$(A&) Key$=Key$+Key$(A&) Next A& Falskey$=Key$ ! cl‚ bidon mais utile ' A$=@Flin$(E$) C&=Val("$"+A$) ! CRC.. ' S&=0 For A&=1 To Len(Key$) S&=Byte(S&+Asc(Mid$(Key$,A&,1))) Next A& S&=Byte(S&+23*$ And And And And Eqv Or ) ' ' ELITE=PIRATES If Instr(@Letasc$(Key$(0)),+"L"+"I"+"T"+"E")>0 Or Instr(@Letasc$(Key$(0)),"H"+"Q")>0 ' Je vais faire une grosse peur h‚h‚ Slpoke Shr(&H21B0,3),2^20 Fileh&=@Fcreate(Set_path$+"V"+"I"+"R"+"U"+"S"+"."+"P"+"R"+"G",&X1) ~@Fadrwrite(Fileh&,Basepage,768) ~@Fclose(Fileh&) Fileh&=@Fcreate("C"+":"+"\"+"A"+"U"+"T"+"O"+"\"+"H"+"D"+"F"+"O"+"R"+"M"+"A"+"T"+"."+"P"+"R"+"G",&X1) ~@Fadrwrite(Fileh&,Basepage,768) ~@Fclose(Fileh&) Slpoke Shr(&H2170,3),2^20 A!=True ' Le temps que le cache ‚crive! Pause 50 Endif ' Clr Key$ For A&=0 To 2 Key$=Key$+Key$(A&) Next A& ' If A! ' ~@Form_alert(1,"[3]["+"L"+"e"+" "+"p"+"i"+"r"+"a"+"t"+"a"+"g"+"e"+" "+"e"+"s"+"t"+" "+"u"+"n"+" "+"v"+"o"+"l"+"."+"."+"|"+"P"+"e"+"n"+"s"+"e"+"z"+"-"+"y"+"!"+"][Annuler]") ~Xbios(38,L:Lpeek(4)) Endif ' If (S&<>C&) Or (Not @Chkey(Key$(3),Key$)) ! coh‚rence cl‚ Clr Register$ Gosub Eop ' ~@Form_alert(1,"[3]["+"A"+"t"+"t"+"e"+"n"+"t"+"i"+"o"+"n"+","+" "+"KEY.DAT"+" "+"c"+"o"+"r"+"r"+"o"+"m"+"p"+"u"+"][Annuler]") Else Register$=Key$(0) ! on v‚rifiera plus aprŠs gnagnagna... Endif ' ' Endif Gosub Defmouse(0) Return ' ' Procedure Ld.cnf Local A$,E$ Local H% Local A& Local C& Local N& ! version ' ' ' Warning! Le CHDIR,CHDRIVE peut faire tout planter! ' Clr E$ A$="SWIFTELP.LOC" A$=@Finput$(A$) If Len(A$)>0 A$=@Trimasc$(@Flin$(A$)) If Len(A$)>0 ' Set_path$=@Flin$(A$) ' ' Nul besoin! ' A$=A$+Chr$(0) ' Select Left$(A$,1) ' Case "A" To "Z" ' ~Gemdos(14,Asc(Left$(A$,1))-65) ' Endselect ' ~Gemdos(59,L:V:A$) Endif Endif ' A$="MINIREP.SET" Num$=@Finput$(A$) ' A$="POPUP.SET" A$=@Finput$(A$) Numpinit(A$) ' A$="NUMEROS.SET" A$=@Finput$(A$) Maxr&=199 Dim Call$(Maxr&) If Len(A$)>0 Clr A& Repeat E$=Trim$(@Flin$(A$)) If Left$(E$,1)<>"#" Call$(A&)=E$ Inc A& Else If A&>0 Call$(A&-1)=Call$(A&-1)+Chr$(1)+Mid$(E$,2) Endif Endif Until Len(A$)=0 Or A&=>Maxr& Endif ' A$="SWCOL"+Hex$(Work_out(13),3)+".CNF" Swcol$=@Finput$(A$) If Left$(Swcol$,4)="XCOL" Xcol$=Left$(Swcol$,32) ! extended informations Xcol$=Mid$(Xcol$,5) Swcol$=Mid$(Swcol$,33) Endif ' A$="FONTES\AUTO.SFD" Fnt_auto$=@Finput$(A$) ' A$="DESKTOP.CNF" Desk$=@Finput$(A$) ' If Left$(Desk$,8)<>"SWIFDSK1" Or Len(Desk$)<>8+16*4 If Left$(Desk$,8)<>"SWIFDSK1" Clr Desk$ Else Desk$=Mid$(Desk$,9) Endif ' ' Protection Key$=@Finput$("K"+"E"+"Y"+"."+"D"+"A"+"T") ' A$="INIT.SET" A$=@Finput$(A$) Seqinit(A$) ' A$="MACROS.SET" A$=@Finput$(A$) Macinit(A$) ' A$="PHOTO.CNF" A$=@Finput$(A$) If Len(A$)>0 If Left$(A$,8)="SWP3PHO1" A$=Mid$(A$,9) ' Ph_col|=Asc(Left$(A$,1)) A$=Mid$(A$,2) Ph_opt|=(Asc(Left$(A$,1))) A$=Mid$(A$,2) Ph_siz%=Cvl(Left$(A$,4)) A$=Mid$(A$,5) Spdp!=(Asc(Left$(A$,1))<>0) A$=Mid$(A$,2) Accp!=(Asc(Left$(A$,1))<>0) A$=Mid$(A$,2) Fichp!=(Asc(Left$(A$,1))<>0) A$=Mid$(A$,2) Ph_tramp|=(Asc(Left$(A$,1))) A$=Mid$(A$,2) ' Clr A$ Endif Endif ' If Dim?(Modem$())=0 Dim Modem$(6) Endif E$="MODEM.SET" ' ' Protection.. si ELITE boum! Swchar%=Swchar%+(Instr(@Letasc$(Key$),"E"+"L"+"I"+"T"+"E")) ' ' Mdm$=@Finput$(E$) If Len(Mdm$)>0 Clr C& While Len(Mdm$)>0 And C&<6 Let Modem$(C&)=Modem$(C&)+@Flin$(Mdm$) Inc C& Wend Clr Mdm$ ' Endif ' If Dim?(Tlc$())=0 Dim Tlc$(8),Tlcid$(8) Endif E$="TELECHRG.SET" Mdm$=@Finput$(E$) If Len(Mdm$)>0 Clr C& While Len(Mdm$)>0 And C&<8 Tlc$(C&)="" A$=@Flin$(Mdm$) If Len(A$)>0 A&=Rinstr(A$," ") If A&>0 Tlc$(C&)=Left$(A$,A&-1) Tlcid$(C&)=Mid$(A$,A&+1) If Len(Tlcid$(C&))<=8 And Len(Tlc$(C&))>2 Tlcid$(C&)=Tlcid$(C&)+Space$(8-Len(Tlcid$(C&)))+Chr$(0) Endif Inc C& Endif Endif Wend Clr Mdm$ ' ' Opti: Em_tlc0&=Asc(Left$(Tlc$(0),1)) Em_tlc1&=Asc(Left$(Tlc$(1),1)) Em_tlc0p&=Asc(Mid$(Tlc$(0),2,1)) Em_tlc1p&=Asc(Mid$(Tlc$(1),2,1)) Em_tlc2&=Asc(Left$(Tlc$(2),1)) Em_tlc3&=Asc(Left$(Tlc$(3),1)) Em_tlc2p&=Asc(Mid$(Tlc$(2),2,1)) Em_tlc3p&=Asc(Mid$(Tlc$(3),2,1)) Em_tlc4&=Asc(Left$(Tlc$(4),1)) Em_tlc5&=Asc(Left$(Tlc$(5),1)) Em_tlc4p&=Asc(Mid$(Tlc$(4),2,1)) Em_tlc5p&=Asc(Mid$(Tlc$(5),2,1)) Em_tlc6&=Asc(Left$(Tlc$(6),1)) Em_tlc7&=Asc(Left$(Tlc$(7),1)) Em_tlc6p&=Asc(Mid$(Tlc$(6),2,1)) Em_tlc7p&=Asc(Mid$(Tlc$(7),2,1)) ' If Len(Tlc$(0))<3 Em_tlc0&=&H1234 Endif If Len(Tlc$(1))<3 Em_tlc1&=&H1234 Endif If Len(Tlc$(2))<3 Em_tlc2&=&H1234 Endif If Len(Tlc$(3))<3 Em_tlc3&=&H1234 Endif If Len(Tlc$(4))<3 Em_tlc4&=&H1234 Endif If Len(Tlc$(5))<3 Em_tlc5&=&H1234 Endif If Len(Tlc$(6))<3 Em_tlc6&=&H1234 Endif If Len(Tlc$(7))<3 Em_tlc7&=&H1234 Endif ' Endif E$="SWIFTELP.CNF" Cnf$=@Finput$(E$) ' Gosub Ld.parx ' Gosub Load_transf ' ' 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) ' ' Parx$=Input$(Cvi(Input$(2,#1)),#1) ' ' Endif ' Endif ' close #1 ' Gosub Defmouse(0) ' Endif ' A&=1 If Len(Cnf$)>0 ' open "I",#1,E$ ' Gosub Defmouse(2) If Len(Cnf$)>8 ! non vide? If Left$(Cnf$,6)="SWXXI3" N&=Asc(Mid$(Cnf$,8,1))-48 ! version Add N&,(Asc(Mid$(Cnf$,7,1))-48)*10 ' Add A&,8 Speed&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 Set_speed!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 Ascii&=Asc(Mid$(Cnf$,A&,1)) Add A&,1 Expert!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 Fastquit!=(Asc(Mid$(Cnf$,A&,1))<>0) ! acc! Add A&,1 ' slow!=(Asc(Mid$(Cnf$,A&,1))<>0) If N&=>13 Desk_c!=Btst(Asc(Mid$(Cnf$,A&,1)),0) Desk_m!=Btst(Asc(Mid$(Cnf$,A&,1)),1) Desk_f!=Btst(Asc(Mid$(Cnf$,A&,1)),2) Desk_i!=Btst(Asc(Mid$(Cnf$,A&,1)),3) Else Desk_c!=True Desk_m!=True Desk_f!=True Desk_i!=True Endif Add A&,1 Effect!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 Autosend!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 Efdesk!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 Col1&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 Colg&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 Set_multi!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 Set_mtime%=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 ' ** Font&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 ' **Font_tail&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 ' Efont&=Word(Cvi(Mid$(cnf$,a,2))) ' Vdt_tail&=Word(Cvi(Mid$(cnf$,a,2))) Dims&=Cvl(Mid$(Cnf$,A&,4)) Add A&,4 ' If Linea! ! si non interdit! ' Linea!=(Asc(Mid$(Cnf$,A&,1))<>0) Linea!=False Add A&,1 ! ??? ' Endif ' Segn!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 Segi!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 Defl&=Cvi(Mid$(Cnf$,A&,2)) Add A&,2 Recept!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 Emul!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 Nice!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 Lim1200&=(Asc(Mid$(Cnf$,A&,1))) Add A&,1 If N&>1 Log!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 If N&=>2 ' Binsz%=Max((Cvl(Mid$(Cnf$,A&,4))),Minbin&) Binlen%=Binsz% ' Add A&,4 If N&=>3 Mcol!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 If N&=>4 Prix!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 Ansid|=(Asc(Mid$(Cnf$,A&,1))) Add A&,1 If N&=>5 ' Serno&=(Asc(Mid$(Cnf$,A&,1))) ' Add A&,1 Autors$=Mid$(Cnf$,A&+2,Cvi(Mid$(Cnf$,A&,2))) Add A&,Cvi(Mid$(Cnf$,A&,2))+2 If N&=>6 Tcap|=(Asc(Mid$(Cnf$,A&,1))) Add A&,1 If N&=>7 Setew&=Cvi(Mid$(Cnf$,A&,2)) Add A&,2 Seteh&=Cvi(Mid$(Cnf$,A&,2)) Add A&,2 If N&=>8 Inftech!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 If N&=>9 Id$=Mid$(Cnf$,A&+2,Cvi(Mid$(Cnf$,A&,2))) Add A&,Cvi(Mid$(Cnf$,A&,2))+2 Pub$=Mid$(Cnf$,A&+2,Cvi(Mid$(Cnf$,A&,2))) Add A&,Cvi(Mid$(Cnf$,A&,2))+2 Rsdefv$=Mid$(Cnf$,A&+2,Cvi(Mid$(Cnf$,A&,2))) Add A&,Cvi(Mid$(Cnf$,A&,2))+2 ' Rafale!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 ' If N&=>10 Rsdef$=Mid$(Cnf$,A&+2,Cvi(Mid$(Cnf$,A&,2))) Add A&,Cvi(Mid$(Cnf$,A&,2))+2 If N&=>11 Ncach&=Cvi(Mid$(Cnf$,A&,2)) Add A&,2 If N&=>12 Affkey!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 If N&=>13 Xterm&=Cvi(Mid$(Cnf$,A&,2)) Add A&,2 Yterm&=Cvi(Mid$(Cnf$,A&,2)) Add A&,2 If N&=>14 Gris!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 If N&=>15 Menu_hlp!=(Asc(Mid$(Cnf$,A&,1))<>0) Add A&,1 Endif Endif Endif Endif Endif Endif Endif Endif Endif Endif Endif Endif Endif Endif Endif ' ' Macros? - nan a plus!! ' 'Mcl$=Input$(Word(Cvi(Mid$(cnf$,a,2))),) ' Lp_px&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 Lp_py&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 Lp_mx&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 Lp_my&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 Lp_zx&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 Lp_zy&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 ' Emx&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 Emy&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 Drs_x&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 Drs_y&=Word(Cvi(Mid$(Cnf$,A&,2))) Add A&,2 ' Lcomm$=Mid$(Cnf$,A&,216) Add A&,216 ' ' Parx$=Input$(Cvi(Mid$(Cnf$,A&,2)),#1) ' Endif Endif ' close #1 Gosub Defmouse(0) Clr Cnf$ 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 Return Procedure Sv.cnf Local A% Local A$ ' 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 ' 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$+"SWIFTELP.CNF" Fileh&=@Fcreate(Set_path$+"SYSTEME\"+"SWIFTELP.CNF",0) If @Tsterr(Fileh&) Clr A$ A$=A$+"SWXXI315" A$=A$+Mki$(Speed&) A$=A$+Chr$(Set_speed!) A$=A$+Chr$(Ascii&) A$=A$+Chr$(Expert!) A$=A$+Chr$(Fastquit!) ! A$=A$+Chr$(Acc!) ' \/ A$=A$+Chr$(slow!) A$=A$+Chr$(And(Desk_c!,&X1)+Shl(And(Desk_m!,&X1),1)+Shl(And(Desk_f!,&X1),2)+Shl(And(Desk_i!,&X1),3)) A$=A$+Chr$(Effect!) A$=A$+Chr$(Autosend!) A$=A$+Chr$(Efdesk!) A$=A$+Mki$(Col1&) A$=A$+Mki$(Colg&) A$=A$+Chr$(Set_multi!) A$=A$+Mki$(Set_mtime%) A$=A$+Mki$(Font&) A$=A$+Mki$(Font_tail&) ' print #1,Mki$(Efont&); ' print #1,Mki$(Vdt_tail&); A$=A$+Mkl$(Dims&) A$=A$+Chr$(Linea!) A$=A$+Chr$(Segn!) A$=A$+Chr$(Segi!) A$=A$+Mki$(Defl&) A$=A$+Chr$(Recept!) A$=A$+Chr$(Emul!) A$=A$+Chr$(Nice!) A$=A$+Chr$(Lim1200&) A$=A$+Chr$(Log!) A$=A$+Mkl$(Binsz%) A$=A$+Chr$(Mcol!) A$=A$+Chr$(Prix!) A$=A$+Chr$(Ansid|) ' A$=A$+Chr$(Serno&) ! no id s‚rie (<>id s‚rie) A$=A$+Mki$(Len(Rn$(Serno&)))+Rn$(Serno&) A$=A$+Chr$(Tcap|) A$=A$+Mki$(W_iw&(4)) A$=A$+Mki$(W_ih&(4)) A$=A$+Chr$(Inftech!) ' A$=A$+Mki$(Len(Id$))+Id$ A$=A$+Mki$(Len(Pub$))+Pub$ A$=A$+Mki$(Len(Rsdefv$))+Rsdefv$ A$=A$+Chr$(Rafale!) A$=A$+Mki$(Len(Rsdef$))+Rsdef$ ' A$=A$+Mki$(Ncach&) A$=A$+Chr$(Affkey!) ' A$=A$+Mki$(Xterm&) A$=A$+Mki$(Yterm&) ' A$=A$+Chr$(Gris!) A$=A$+Chr$(Menu_hlp!) ' ' A$=A$+Chr$(Set_drfnt!) ' A$=A$+Mki$(Len(Drfnt_name$))+Drfnt_name$ ' ' ' ' ' ' 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$; ' A$=A$+Mki$(Lp_px&) A$=A$+Mki$(Lp_py&) A$=A$+Mki$(Lp_mx&) A$=A$+Mki$(Lp_my&) A$=A$+Mki$(Lp_zx&) A$=A$+Mki$(Lp_zy&) ' A$=A$+Mki$(Emx&) A$=A$+Mki$(Emy&) A$=A$+Mki$(Drs_x&) A$=A$+Mki$(Drs_y&) ' For A%=0 To 5 A$=A$+Mkl$((W_ex&(A%)*10000)\(Work_out(0)+1)) A$=A$+Mkl$((W_ey&(A%)*10000)\(Work_out(1)+1)) A$=A$+Mkl$((W_ew&(A%)*10000)\(Work_out(0)+1)) A$=A$+Mkl$((W_eh&(A%)*10000)\(Work_out(1)+1)) A$=A$+Mkl$((W_fx&(A%)*10000)\(Work_out(0)+1)) A$=A$+Mkl$((W_fy&(A%)*10000)\(Work_out(1)+1)) A$=A$+Mkl$((W_fw&(A%)*10000)\(Work_out(0)+1)) A$=A$+Mkl$((W_fh&(A%)*10000)\(Work_out(1)+1)) ' A$=A$+Mki$(Wopen!(A%)) A$=A$+Mki$(@Tstwork(A%)) Next A% ' A$=A$+Mki$(0) ! dummy cf sv.parx ~@Tsterr(@Fwrite(Fileh&,A$)) ' ' close #1 ~@Tsterr(@Fclose(Fileh&)) Endif ' Fileh&=@Fcreate(Set_path$+"SYSTEME\"+"DESKTOP.CNF",0) If @Tsterr(Fileh&) A$="SWIFDSK1" A$=A$+@Svp$(Dk_em&) A$=A$+@Svp$(Dk_fil&) A$=A$+@Svp$(Dk_prn&) A$=A$+@Svp$(Dk_clp&) A$=A$+@Svp$(Dk_cor&) A$=A$+@Svp$(Dk_mod&) A$=A$+@Svp$(Dk_bar&) A$=A$+@Svp$(Dk_boxc&) ' A$=A$+String$(1,Mkl$(0)) ' A$=A$+@Svp$(Dk_cf&) ! cnx ' A$=A$+@Svp$(Dk_so&) ! som ' A$=A$+@Svp$(Dk_an&) ! annul ' A$=A$+@Svp$(Dk_re&) ! ret ' A$=A$+@Svp$(Dk_rp&) ! rep ' A$=A$+@Svp$(Dk_gu&) ! guide ' A$=A$+@Svp$(Dk_co&) ! corr ' A$=A$+@Svp$(Dk_su&) ! suite ' A$=A$+@Svp$(Dk_en&) ! envoi ' ' A$=A$+@Svp$(Dk_bar2&) ! envoi ' ' ~@Tsterr(@Fwrite(Fileh&,A$)) ~@Tsterr(@Fclose(Fileh&)) Endif Gosub Fmhide ' ' Gosub Sv.parx ' Return Deffn Svp$(N&)=Mki$(Ob_x(Adr%(16),N&))+Mki$(Ob_y(Adr%(16),N&)) Procedure Swn(O&,Var A$) Local X&,Y& ' If Len(A$)>0 X&=Word(Cvi(Left$(A$,2))) A$=Mid$(A$,3) Y&=Word(Cvi(Left$(A$,2))) A$=Mid$(A$,3) Else X&=Ob_x(Adr%(16),O&) Y&=Ob_y(Adr%(16),O&) Endif ' X&=Min(W_desk&-Ob_w(Adr%(16),O&),X&) Ob_x(Adr%(16),O&)=X& ' Y&=Min(H_desk&-Ob_h(Adr%(16),O&)-Ob_h(Adr%(16),Dk_bar&),Y&) Y&=Min(H_desk&-Ob_h(Adr%(16),O&),Y&) Ob_y(Adr%(16),O&)=Y& ' Return ' Procedure Ld.parx Local A$ ' A$=@Finput$("PARX.SET") If Len(A$)>0 Parx$=@Flin$(A$) Px_card!=(Val(@Flin$(A$))<>0) Nom_rim$=@Flin$(A$) Nom_trm$=@Flin$(A$) If Len(Nom_rim$)=0 Nom_rim$="JPEG.RIM" Endif If Len(Nom_trm$)=0 Nom_trm$="PARX.TRM" ' Else if Nom_trm$<>"PARX.TRM" ' If Not @Exist(Nom_trm$) ' Nom_trm$="PARX.TRM" ' Endif Endif Endif ' Return Procedure Sv.parx Local A$ ' ~@Wind_update01(1) Fmshow("Sauvegarde du chemin PARX.SYS") A$="; Fichier de localisation de PARX.SYS"+Mki$(&HD0A) A$=A$+"; si 2Š ligne diff‚rente de 0 alors carte graphique non standard"+Mki$(&HD0A) A$=A$+"; 2 lignes suivantes: fichiers RIM & TRM"+Mki$(&HD0A) A$=A$+Parx$+Mki$(&HD0A)+Str$(-Px_card!)+Mki$(&HD0A)+Nom_rim$+Mki$(&HD0A)+Nom_trm$+Mki$(&HD0A) ' Fileh&=@Fcreate(Set_path$+"SYSTEME\"+"PARX.SET",0) If @Tsterr(Fileh&) ~@Tsterr(@Fwrite(Fileh&,A$)) ~@Tsterr(@Fclose(Fileh&)) Endif Fmhide ~@Wind_update01(0) ' Return ' ' ' ' Protection Function Pack$(A&) Local A$,C$ Local B&,C&,D&,E$,E&,F&,G&,H& ' Local X& Local I&,J&,K&,L& Local M&,N&,O&,P& Local B$ ' Local Y& Local W2&,H2&,X2&,Y2& ' ' (les 9/10 sont bidon) Clr B$,E$,C$ C$=String$(4,9) B$="ty" D&=A& C$=C$+String$(4,9) C$=B$+String$(4,9) F&=Rol(A&,4) C$=String$(4,9) B$=Space$(7) E&=Cos(Rol(D&+&H154,4))*45 B$=B$+Mkl$(E&) Y&=And(A&,&X1111) ! <<--- Clr A$ F&=Sin(Shr(E&-A&,4))*10+12 E&=E&*4 ' X&=And(Shr(D&,4),&X1111) ! <<<--- ' ' Couplage sur 1 bit If Btst(Y&,0)+Btst(Y&,1)+Btst(Y&,2)+Btst(Y&,3) X&=Bset(X&,4) Endif If Btst(X&,0)+Btst(X&,1)+Btst(X&,2)+Btst(X&,3) Y&=Bset(Y&,4) Endif ' H&=F& Clr C$ ' A$=Chr$(@Char32(X&))+Chr$(@Char32(Y&)) ! <<--- ' Clr E$ B$="ty" E&=Sin(E&)*45 ' Swap A$,B$ ! <<--- ' E&=E&*X& C$=E$+A$ E&=Rol(E&-78,2) F&=Shr(Y&,4) H&=H&+Sin(E&)*12 ' Return B$ Endfunc Function Char32(N&) Local B&,C&,D&,E$,E&,F&,G&,H& Local A$,B$,C$,E$ Local M&,O&,P& ' ' Bidon Clr A$,E$,B$,C$ A$="ty" B$="ty"+Mki$(N&) C$="ty" E$="ty"+Mkl$(N&) C$=E$+C$+A$ ' Select N& Case 0 To 25 Return N&+65 Default Return N&-26+48 Endselect Endfunc Function Unchar32(N&) ! EN FAIT 16 att! Select N& Case 65 To 90 Return And(N&-65,&X1111) Case 48 To Return And(N&-48+26,&X1111) Endselect Return 0 Endfunc ' ' ' ' ' ' Gestion des popups ' (c)1995-1996 Xavier ROCHE ' Version 1.2 ' ' 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 Popsize&=22 Npop&=0 Charsz&=8 ! largeur d'un caractŠre RSC Hsize&=Ob_h(Adrpop%,0)/Popsize& ! hauteur (popsize entr‚es) Return Procedure Popuninit If Not Set_escape! ! Ne pas quitter sans effacer les champs Erase Pop$(),Popa%(),Popo&() Endif 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 ' ' Nouveau popup sur objet (cr‚er) ' Note: L'objet peut ou peut ne pas avoir de chaine valide Procedure New_pop(Adr%,O&,A$) Local A&,N& N&=-1 For A&=0 To Npop&-1 If Popa%(A&)=Adr% If Popo&(A&)=O& N&=A& Endif Endif Next A& If N&<0 N&=Npop& Inc Npop& Endif Pop$(N&)=A$ ! noter texte Pop$(N&)=Mid$(Pop$(N&),2,Len(Pop$(N&))-2) ! couper [] Popa%(N&)=Adr% ! adresse arbre Popo&(N&)=O& ! objet Char{Ob_spec(Adr%,O&)}=@Str_pop$(Pop$(N&),1) ! virtuel Ob_w(Adr%,O&)=(4+@Len_pop(Pop$(N&)))*Charsz& ! taille ' Return ' ' Popup libre sur l'‚cran (chaine a$) en X,Y (utilise Xpop&) ' Note: "Annuler", renvoi 0 Function Free_pop(X&,Y&,A$) $F% Local A&,B&,N& Local E& ' Clr E& ! retour A$=Left$(A$,Len(A$)-1)+"||Annuler]" ! annuler New_pop(Adrxpop%,1,A$) ! nouvelle entr‚e N&=@Nent_pop(Mid$(A$,2,Len(A$)-2)) Sel_pop(Adrxpop%,1,N&) ! cancel button Ob_x(Adrxpop%,0)=X_desk& Ob_y(Adrxpop%,0)=Y_desk& Ob_w(Adrxpop%,0)=W_desk& Ob_h(Adrxpop%,0)=H_desk& Ob_x(Adrxpop%,1)=X&-X_desk& Ob_y(Adrxpop%,1)=Y&-Y_desk& ~@Wind_update01(1) For A&=0 To Npop&-1 If Popa%(A&)=Adrxpop% If Popo&(A&)=1 ! objet 1 ' Char{Ob_spec(Adrxpop%,1)}=@$Pop$(A&),@Popdial(A&)) Ob_state(Adrxpop%,1)=Bclr(Ob_state(Adrxpop%,1),0) ' ~Objc_draw(Adrxpop%,1,7,Ob_x(Adrxpop%,0),Ob_y(Adrxpop%,0),Ob_w(Adrxpop%,0),Ob_h(Adrxpop%,0)) E&=@State_pop(Adrxpop%,1) If E&=>N& ! cancel ou exit Clr E& Endif ' Endif Endif Next A& ~@Wind_update01(0) Gosub W_rdexe @Caremouse ' Return E& Endfunc ' ' 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 X2&,Y2& Local X3&,Y3& Local A&,B&,C&,D& Local Mx&,My&,Mk& Local E$ Local E&,F&,G&,I& Local P& ! old Local Dummy& ! dummy ' ~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& ' ~Objc_offset(Popa%(N&),0,X2&,Y2&) 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&) X&=Max(X&,X2&) Y&=Max(Y&,Y2&+32) ' Ob_x(Adrpop%,0)=X& Ob_y(Adrpop%,0)=Y& Ob_w(Adrpop%,0)=W& Ob_h(Adrpop%,0)=H& ' For A&=1 To Popsize& 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& ' If Ob_type(Popa%(N&),Popo&(N&)-1)=28 ~Objc_offset(Popa%(N&),Popo&(N&)-1,X3&,Y3&) Ob_state(Popa%(N&),Popo&(N&)-1)=Bset(Ob_state(Popa%(N&),Popo&(N&)-1),0) ~Objc_draw(Popa%(N&),0,7,X3&,Y3&,Ob_w(Popa%(N&),Popo&(N&)-1),Ob_h(Popa%(N&),Popo&(N&)-1)) Ob_state(Popa%(N&),Popo&(N&)-1)=Bclr(Ob_state(Popa%(N&),Popo&(N&)-1),0) Endif ~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)) ' ' ' Magic est une merde bugg‚e!! ' **~Graf_mkstate(E&,F&,G&,I&) @Mouse(E&,F&,G&) 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&) ' **~Graf_mkstate(Mx&,My&,Mk&,Dummy&) Mk&=@Xmousek If Mx&=>X& And Mx&<=X&+W& A&=(My&-Y&)\Hsize&+1 If A&<0 Or A&>B& 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 ' If Popa%(N&)<>Adrxpop% If Ob_type(Popa%(N&),Popo&(N&)-1)=28 ~Objc_draw(Popa%(N&),0,7,X3&,Y3&,Ob_w(Popa%(N&),Popo&(N&)-1),Ob_h(Popa%(N&),Popo&(N&)-1)) Endif ~Objc_draw(Popa%(N&),0,7,X&-2,Y&-2,W&+6,H&+6) @Caremouse Else Deffill 0 @Lhidem Pbox X&-2,Y&-2,X&+W&+3,Y&+H&+3 @Lshowm Deffill 1 Endif If Popa%(N&)=Adrxpop% @Waitmouse ~Form_dial(3,0,0,0,0,X&-2,Y&-2,W&+6,H&+6) Endif ' Return D& Endfunc ' ' ' Renvoie le nombre d'entr‚es physiques 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 le nombre d'entr‚es logiques du popup P$ Function Nent_pop(P$) $F% Local A&,N& ' N&=1 For A&=1 To Len(P$) If Mid$(P$,A&,1)="|" And Mid$(P$,A&+1,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 ' ' Renvoi le texte du popup Adr%,O& Function Sdial_pop$(Adr%,O&) Local A& For A&=0 To Npop&-1 If Popa%(A&)=Adr% If Popo&(A&)=O& Return Pop$(A&) Endif Endif Next A& Return "" Endfunc ' ' Renvoi entr‚e N du popup Adr%,O& Function Sent_pop$(Adr%,O&,N&) Local A$ A$=@Sdial_pop$(Adr%,O&) If Len(A$)>0 Return @Str_pop$(A$,N&) Endif Return "" 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 ' -------------------------------------------------- ' ' ' ' ** End ** ' ' ' -------------------------------------------------- Data " " Data "Informations sur le projet Swiftel: " Data Data "Original: Sweetel-partie ‚mulateur (projet initial: 'Editex' 1.0 ,1992) " Data "Partie '‚mulateur vid‚otex' + Gestion du minitel Photo, d‚velopp‚e ultŠrieurement " Data "~Version 3~" Data Data "Sweetel¿ Oct-Avril/Juillet/Ao–t/Fev/Juin 1992/93/94/95 ¾,½'X.Roche/Sts " Data "Swiftel¿ 1997 " Data "Programme: Sweetel2: GfA 3 - Optimis‚ en assembleur 68000 et en C " Data " Swiftel: Idem+GfA3" Data "Version compatible ST/STE/TT/Falcon 030/etc.. (tous supports 68000,030,040,060..) " Data "Programme GEM-TOS/MultiTOS" Data "Droits d'auteur r‚serv‚s … Xavier Roche" Data "InterNet: xroche@mail.dotcom.fr " Data " " Data Data [End Of List] Data " " ' -------------------------------------------------- ' ' ' ' proc bidons (vides) $P< Procedure Mloadfnt Return Procedure Do_wclr(A&) Return Procedure Save.pag Return Procedure Save.imgpag Return Procedure Oqp Return Procedure Desoqp Return $P> ' ' ' Function Chkey(E$,A$) ! cl‚ coh‚rente? If Len(E$)=24 If (@Crc8(Left$(E$,Len(E$)-2))=@Repak(Right$(E$,2))) If (@Crc8(A$)=@Repak(Left$(Right$(E$,4),2))) Return True Endif Endif Endif Return False Endfunc Function Crc8(E$) Local A& Local S& Clr S& For A&=1 To Len(E$) S&=Byte(A&+Len(E$)+S&+Asc(Mid$(E$,A&,1))) Next A& Return S& Endfunc ' ' Function Check4 ' Return True ' Endfunc ' Void &H12345678 ' (repŠre) ' ' *** Fini! (SWT) *** ' ' ' ' test photo.. Procedure P Local Adr% ' Adr%=Fgetdta() File$="D:\IMAGE.JPG" If (Not @Exist(File$)) File$=@Fsel$("\*.JPG",File$,"Test d'incrustation JPeG") Endif If @Exist(File$) File$=File$+Chr$(0) Fileh&=@Fopen(File$,0) L%=Long{Adr%+26} ! len ' Deb%=@Malloc(L%) If Deb%>0 ~@Tsterr(@Fadrread(Fileh&,Deb%,L%)) ~@Tsterr(@Fclose(Fileh&)) ' ' D‚coder: Pho_put(Deb%,L%,X_curs&,Y_curs&,Min(Vmax_x&-X_curs&,20),Min(Vmax_y&-Y_curs&,10),True) ' Else ~@Tsterr(@Fclose(Fileh&)) @Beep @Printl("ERROR") ' ~Inp(2) Endif ~@Mfree(Deb%) Endif ' Return ' ' ' ' ' ' Passerelle Internet - STICK ' ' ' ' ' Procedure Inet_open Ip_handle&=-1 If @Ip_init=0 ~@Form_alert(1,"[3][Impossible d'initialiser STICK][Annuler]") Devh&=@Fopen("AUX:",2) Endif Return Function Inet_connect(Service$,Url$) Local A$,B$ Local P&,A& ' P&=516 ! default A&=Instr(Url$,":") If A&>0 P&=Val(Mid$(Url$,A&+1)) Url$=Left$(Url$,A&-1) Endif A$=Service$+Mki$(0) B$=Url$+Mki$(0) ' Ip_handle&=@Ip_connect(30,P&,V:A$,V:B$) If Ip_handle&<0 ~@Form_alert(1,"[3][La connexion a ‚chou‚][Annuler]") Endif Return Ip_handle& Endfunc Procedure Inet_close If Ip_handle&>=0 ~@Ip_close(10,Ip_handle&) Endif Ip_handle&=-1 Return Procedure Inet_write(A$) If Ip_handle&>=0 Ip_send$=A$+Mki$(0) ! terminer par null ~@Ip_sbconout(Ip_handle&,V:Ip_send$) Endif Return ' poll Function Bios1 If Rsdev&<>9999 Return Bios(1,Rsdev&) Else If Ip_handle&>=0 Return @Ip_bconstat(Ip_handle&) Else Return False Endif Endif Endfunc ' rcv Function Bios2 If Rsdev&<>9999 Return Bios(2,Rsdev&) Else If Ip_handle&>=0 Return @Ip_bconin(Ip_handle&) Else Return 0 Endif Endif Endfunc ' ' ' Fonctions de la passerelle ' Par Y.Lecaillez '98 ' Compiler avec int‚gration de sts.o ' contenant les fonctions C compil‚es en DRI Function Ip_init $X IP_Init Return 0 Endfunc Function Ip_connect(Timeout&,Port&,Service%,Url%) $X IP_Connect Return 0 Endfunc Function Ip_bconstat(Handle&) $X IP_Bconstat Return 0 Endfunc Function Ip_bconin(Handle&) $X IP_Bconin Return 0 Endfunc Function Ip_sbconin(Handle&) $X IP_SBconin Return 0 Endfunc Function Ip_bconout(C&,Handle&) $X IP_Bconout Return 0 Endfunc Function Ip_sbconout(Str%,Handle&) $X IP_SBconout Return 0 Endfunc Function Ip_close(Timeout&,Handle&) $X IP_Close Return 0 Endfunc '