' ****************************************************************************** ' **** EB Modeleur Universel Version 3.59g **** ' **** Importation d'objets 3D Studio (Discret) (*.3DS) **** ' **** (C) BARANGER Emmanuel GFA 3.6TTE **** ' **** 31, rue de la porte Morard **** ' **** 28000 Chartres **** ' **** France T‚l‚phone : 02 37 35 67 02 17/05/2005 **** ' **** WEB : http://helijah.free.fr ou http://ebmodel3.atari.org **** ' **** email : embaranger@wanadoo.fr **** ' ****************************************************************************** $m10240 ! Pour le compilateur variables_diverses ! Des variables globales multitache!=(WORD{{GB+4}+2}<>1) ! Sommes nous en multitache ? lire_le_fichier_de_transfert ! Lecture fichier de protocole chemin_systeme_module ! Chemin systŠme du module IF @version(version%)>3.58 ! Est-ce la bonne version initialisation ! Allez, on initialise tout cela ap_id&=@appl_init ! Et une application, une ! IF @lire_le_ressource_module=TRUE ! Oh ! un ressource dans le module etude_du_systeme ! MagiC! est-il l… ? IF maxcol&<15 ! Y'a pas assez de couleurs environnement_mono ! Mettre les ressource en gris tram‚ ELSE environnement_coul ! Mettre les ressource en gris clair ENDIF importer_le_fichier ! Aller, on charge le fichier libere(*zone%) ! On libŠre la m‚moire ~@rsrc_free ! et puis on libŠre tout. ELSE ecrire_le_fichier_de_transfert_vide ENDIF appl_exit ELSE CHAR{mem_nom%}="[3][Mauvaise version de module |Bad module version][ D‚sol‚ | Sorry ]"+CHR$(0) ~@afficher_alerte(mem_nom%) ecrire_le_fichier_de_transfert_vide ENDIF QUIT 0 ' **************** Gestion du fichier de protocole EB_MODEL.SHM **************** PROCEDURE lire_le_fichier_de_transfert ! Lecture fichier de protocole LOCAL termine!,ligne%,libere! ' precalcul%=@prendre(256,FALSE,3) ligne%=@prendre(1024,TRUE,3) libere!=TRUE ' OPEN "i",#1,@eb_temp$+"\eb_model.shm" IF LOF(#1) DO membfill(ligne%,1024,0) termine!=@lire_une_ligne(ligne%) EXIT IF LEFT$(CHAR{ligne%},3)="EOF" IF LEN(CHAR{ligne%})>1 $S$,$S> SELECT VAL(LEFT$(CHAR{ligne%},3)) CASE 0 enleve_code(ligne%) vdihandle%=VAL(CHAR{ligne%}) CASE 1 enleve_code(ligne%) station%=VAL(CHAR{ligne%}) CASE 2 enleve_code(ligne%) etendue%=VAL(CHAR{ligne%}) CASE 3 enleve_code(ligne%) machine|=VAL(CHAR{ligne%}) CASE 4 enleve_code(ligne%) pro|=VAL(CHAR{ligne%}) CASE 5 enleve_code(ligne%) copro|=VAL(CHAR{ligne%}) CASE 6 enleve_code(ligne%) video|=VAL(CHAR{ligne%}) CASE 7 enleve_code(ligne%) dial!=VAL(CHAR{ligne%}) CASE 8 enleve_code(ligne%) backup!=VAL(CHAR{ligne%}) CASE 9 enleve_code(ligne%) texture_avant!=VAL(CHAR{ligne%}) CASE 10 enleve_code(ligne%) preview_texture!=VAL(CHAR{ligne%}) CASE 11 enleve_code(ligne%) camera_visible!=VAL(CHAR{ligne%}) CASE 12 enleve_code(ligne%) primitive&=VAL(CHAR{ligne%}) CASE 13 enleve_code(ligne%) nombre_d_objets&=VAL(CHAR{ligne%}) CASE 14 enleve_code(ligne%) limite_des_objets&=VAL(CHAR{ligne%}) CASE 15 enleve_code(ligne%) lecteur%=VAL(CHAR{ligne%}) CASE 16 enleve_code(ligne%) ress%=VAL(CHAR{ligne%}) CASE 17 enleve_code(ligne%) les_alertes%=VAL(CHAR{ligne%}) CASE 18 enleve_code(ligne%) include_texture%=VAL(CHAR{ligne%}) CASE 19 enleve_code(ligne%) include_pigment%=VAL(CHAR{ligne%}) CASE 20 enleve_code(ligne%) include_normal%=VAL(CHAR{ligne%}) CASE 21 enleve_code(ligne%) include_finish%=VAL(CHAR{ligne%}) CASE 22 enleve_code(ligne%) include_couleur%=VAL(CHAR{ligne%}) CASE 23 enleve_code(ligne%) include_interior%=VAL(CHAR{ligne%}) CASE 24 enleve_code(ligne%) include_color_map%=VAL(CHAR{ligne%}) CASE 25 enleve_code(ligne%) include_texture_map%=VAL(CHAR{ligne%}) CASE 26 enleve_code(ligne%) include_pigment_map%=VAL(CHAR{ligne%}) CASE 27 enleve_code(ligne%) include_normal_map%=VAL(CHAR{ligne%}) CASE 28 enleve_code(ligne%) include_warps%=VAL(CHAR{ligne%}) CASE 29 enleve_code(ligne%) include_projection%=VAL(CHAR{ligne%}) CASE 30 enleve_code(ligne%) zone_color_map%=VAL(CHAR{ligne%}) CASE 31 enleve_code(ligne%) zone_slop_map%=VAL(CHAR{ligne%}) CASE 32 enleve_code(ligne%) zone_projection%=VAL(CHAR{ligne%}) CASE 33 enleve_code(ligne%) total_texture&=VAL(CHAR{ligne%}) CASE 34 enleve_code(ligne%) total_pigment&=VAL(CHAR{ligne%}) CASE 35 enleve_code(ligne%) total_normal&=VAL(CHAR{ligne%}) CASE 36 enleve_code(ligne%) total_finish&=VAL(CHAR{ligne%}) CASE 37 enleve_code(ligne%) total_couleur&=VAL(CHAR{ligne%}) CASE 38 enleve_code(ligne%) total_interior&=VAL(CHAR{ligne%}) CASE 39 enleve_code(ligne%) total_texture_map&=VAL(CHAR{ligne%}) CASE 40 enleve_code(ligne%) total_pigment_map&=VAL(CHAR{ligne%}) CASE 41 enleve_code(ligne%) total_normal_map&=VAL(CHAR{ligne%}) CASE 42 enleve_code(ligne%) total_total_warps&=VAL(CHAR{ligne%}) CASE 43 enleve_code(ligne%) total_projection&=VAL(CHAR{ligne%}) CASE 44 enleve_code(ligne%) total_color_map&=VAL(CHAR{ligne%}) CASE 45 enleve_code(ligne%) total_slop_map&=VAL(CHAR{ligne%}) CASE 46 enleve_code(ligne%) hwind%=VAL(CHAR{ligne%}) CASE 47 enleve_code(ligne%) univers%=VAL(CHAR{ligne%}) CASE 48 enleve_code(ligne%) texture%=VAL(CHAR{ligne%}) CASE 49 enleve_code(ligne%) pigment%=VAL(CHAR{ligne%}) CASE 50 enleve_code(ligne%) normal%=VAL(CHAR{ligne%}) CASE 51 enleve_code(ligne%) finish%=VAL(CHAR{ligne%}) CASE 52 enleve_code(ligne%) interior%=VAL(CHAR{ligne%}) CASE 53 enleve_code(ligne%) camera%=VAL(CHAR{ligne%}) CASE 54 enleve_code(ligne%) source%=VAL(CHAR{ligne%}) CASE 55 enleve_code(ligne%) atmosphere%=VAL(CHAR{ligne%}) CASE 56 enleve_code(ligne%) defaut_texture%=VAL(CHAR{ligne%}) CASE 57 enleve_code(ligne%) defaut_pigment%=VAL(CHAR{ligne%}) CASE 58 enleve_code(ligne%) defaut_normal%=VAL(CHAR{ligne%}) CASE 59 enleve_code(ligne%) defaut_finish%=VAL(CHAR{ligne%}) CASE 60 enleve_code(ligne%) defaut_interior%=VAL(CHAR{ligne%}) CASE 61 enleve_code(ligne%) objet%=VAL(CHAR{ligne%}) CASE 62 enleve_code(ligne%) back_fond%=VAL(CHAR{ligne%}) CASE 63 enleve_code(ligne%) bit_smooth|=VAL(CHAR{ligne%}) CASE 64 enleve_code(ligne%) bit_in_out|=VAL(CHAR{ligne%}) CASE 65 enleve_code(ligne%) coord_polygon%=VAL(CHAR{ligne%}) CASE 66 enleve_code(ligne%) commande%=VAL(CHAR{ligne%}) CASE 67 enleve_code(ligne%) libere(*precalcul%) precalcul%=VAL(CHAR{ligne%}) libere!=FALSE CASE 68 enleve_code(ligne%) matrice%=VAL(CHAR{ligne%}) CASE 69 enleve_code(ligne%) matrice_cam%=VAL(CHAR{ligne%}) CASE 70 enleve_code(ligne%) zoo%=VAL(CHAR{ligne%}) CASE 71 enleve_code(ligne%) came_pyra%=VAL(CHAR{ligne%}) CASE 72 enleve_code(ligne%) spot_cone%=VAL(CHAR{ligne%}) CASE 73 enleve_code(ligne%) nom_calque%=VAL(CHAR{ligne%}) CASE 74 enleve_code(ligne%) edge%=VAL(CHAR{ligne%}) CASE 75 enleve_code(ligne%) ttf%=VAL(CHAR{ligne%}) CASE 76 enleve_code(ligne%) mem_nom%=VAL(CHAR{ligne%}) CASE 77 enleve_code(ligne%) nom_en_cours%=VAL(CHAR{ligne%}) CASE 78 enleve_code(ligne%) nom_divers%=VAL(CHAR{ligne%}) CASE 79 enleve_code(ligne%) nom_mouvement%=VAL(CHAR{ligne%}) CASE 80 enleve_code(ligne%) masque%=VAL(CHAR{ligne%}) CASE 81 enleve_code(ligne%) msq%=VAL(CHAR{ligne%}) CASE 82 enleve_code(ligne%) mem_che%=VAL(CHAR{ligne%}) CASE 83 enleve_code(ligne%) disque%=VAL(CHAR{ligne%}) CASE 84 enleve_code(ligne%) path%=VAL(CHAR{ligne%}) CASE 85 enleve_code(ligne%) focale&=VAL(CHAR{ligne%}) CASE 86 enleve_code(ligne%) transfert%=VAL(CHAR{ligne%}) CASE 87 enleve_code(ligne%) version%=VAL(CHAR{ligne%}) CASE 88 enleve_code(ligne%) date%=VAL(CHAR{ligne%}) CASE 89 enleve_code(ligne%) smooth!=VAL(CHAR{ligne%}) CASE 90 enleve_code(ligne%) primitives_simples!=VAL(CHAR{ligne%}) CASE 91 enleve_code(ligne%) primitive_segment&=VAL(CHAR{ligne%}) CASE 92 enleve_code(ligne%) primitive_boite&=VAL(CHAR{ligne%}) CASE 93 enleve_code(ligne%) primitive_sphere&=VAL(CHAR{ligne%}) CASE 94 enleve_code(ligne%) primitive_prisme&=VAL(CHAR{ligne%}) CASE 95 enleve_code(ligne%) primitive_triangle&=VAL(CHAR{ligne%}) CASE 96 enleve_code(ligne%) primitive_tronc_de_cone&=VAL(CHAR{ligne%}) CASE 97 enleve_code(ligne%) primitive_hemisphere&=VAL(CHAR{ligne%}) CASE 98 enleve_code(ligne%) primitive_boite_arrondie&=VAL(CHAR{ligne%}) CASE 99 enleve_code(ligne%) primitive_disque&=VAL(CHAR{ligne%}) CASE 100 enleve_code(ligne%) primitive_pyramide&=VAL(CHAR{ligne%}) CASE 101 enleve_code(ligne%) primitive_colonne&=VAL(CHAR{ligne%}) CASE 102 enleve_code(ligne%) primitive_plan&=VAL(CHAR{ligne%}) CASE 103 enleve_code(ligne%) primitive_tore&=VAL(CHAR{ligne%}) CASE 104 enleve_code(ligne%) taille_objet&=VAL(CHAR{ligne%}) CASE 105 enleve_code(ligne%) taille_texture&=VAL(CHAR{ligne%}) CASE 106 enleve_code(ligne%) taille_pigment&=VAL(CHAR{ligne%}) CASE 107 enleve_code(ligne%) taille_normal&=VAL(CHAR{ligne%}) CASE 108 enleve_code(ligne%) taille_finish&=VAL(CHAR{ligne%}) CASE 109 enleve_code(ligne%) taille_interior&=VAL(CHAR{ligne%}) CASE 110 enleve_code(ligne%) taille_couleur&=VAL(CHAR{ligne%}) CASE 111 enleve_code(ligne%) taille_camera&=VAL(CHAR{ligne%}) CASE 112 enleve_code(ligne%) taille_atmosphere&=VAL(CHAR{ligne%}) CASE 113 enleve_code(ligne%) taille_color_map&=VAL(CHAR{ligne%}) CASE 114 enleve_code(ligne%) taille_slop_map&=VAL(CHAR{ligne%}) CASE 115 enleve_code(ligne%) taille_source&=VAL(CHAR{ligne%}) CASE 116 enleve_code(ligne%) taille_projection&=VAL(CHAR{ligne%}) CASE 117 enleve_code(ligne%) nombre_de_source&=VAL(CHAR{ligne%}) CASE 118 enleve_code(ligne%) offset_couleur&=VAL(CHAR{ligne%}) CASE 119 enleve_code(ligne%) offset_csg_type&=VAL(CHAR{ligne%}) CASE 120 enleve_code(ligne%) offset_relation_csg&=VAL(CHAR{ligne%}) CASE 121 enleve_code(ligne%) offset_nom_objet&=VAL(CHAR{ligne%}) CASE 122 enleve_code(ligne%) offset_calque&=VAL(CHAR{ligne%}) CASE 123 enleve_code(ligne%) offset_rapport&=VAL(CHAR{ligne%}) CASE 124 enleve_code(ligne%) offset_nom_montagne&=VAL(CHAR{ligne%}) CASE 125 enleve_code(ligne%) offset_force_blob&=VAL(CHAR{ligne%}) CASE 126 enleve_code(ligne%) offset_drapeau0&=VAL(CHAR{ligne%}) CASE 127 enleve_code(ligne%) offset_drapeau1&=VAL(CHAR{ligne%}) CASE 128 enleve_code(ligne%) bit_ombre|=VAL(CHAR{ligne%}) CASE 129 enleve_code(ligne%) bit_masque|=VAL(CHAR{ligne%}) CASE 130 enleve_code(ligne%) bit_ouvert|=VAL(CHAR{ligne%}) CASE 131 enleve_code(ligne%) bit_biblio|=VAL(CHAR{ligne%}) CASE 132 enleve_code(ligne%) bit_bicubic|=VAL(CHAR{ligne%}) CASE 133 enleve_code(ligne%) bit_montagne|=VAL(CHAR{ligne%}) CASE 134 enleve_code(ligne%) bit_facette|=VAL(CHAR{ligne%}) CASE 135 enleve_code(ligne%) bit_quadric|=VAL(CHAR{ligne%}) CASE 136 enleve_code(ligne%) bit_quartic|=VAL(CHAR{ligne%}) CASE 137 enleve_code(ligne%) bit_4d_julia|=VAL(CHAR{ligne%}) CASE 138 enleve_code(ligne%) bit_lathe|=VAL(CHAR{ligne%}) CASE 139 enleve_code(ligne%) bit_sor|=VAL(CHAR{ligne%}) CASE 140 enleve_code(ligne%) bit_prisme|=VAL(CHAR{ligne%}) CASE 141 enleve_code(ligne%) bit_texte|=VAL(CHAR{ligne%}) CASE 142 enleve_code(ligne%) offset_defaut&=VAL(CHAR{ligne%}) CASE 143 enleve_code(ligne%) bit_defaut|=VAL(CHAR{ligne%}) CASE 144 enleve_code(ligne%) bit_spot|=VAL(CHAR{ligne%}) CASE 145 enleve_code(ligne%) bit_surface|=VAL(CHAR{ligne%}) CASE 146 enleve_code(ligne%) bit_objet_lie|=VAL(CHAR{ligne%}) CASE 147 enleve_code(ligne%) bit_cylindre|=VAL(CHAR{ligne%}) CASE 148 enleve_code(ligne%) bit_attenuation|=VAL(CHAR{ligne%}) CASE 149 enleve_code(ligne%) bit_shadowless|=VAL(CHAR{ligne%}) CASE 150 enleve_code(ligne%) bit_atmosphere|=VAL(CHAR{ligne%}) CASE 151 enleve_code(ligne%) vue_de_face|=VAL(CHAR{ligne%}) CASE 152 enleve_code(ligne%) vue_de_dos|=VAL(CHAR{ligne%}) CASE 153 enleve_code(ligne%) vue_de_gauche|=VAL(CHAR{ligne%}) CASE 154 enleve_code(ligne%) vue_de_droite|=VAL(CHAR{ligne%}) CASE 155 enleve_code(ligne%) vue_de_dessus|=VAL(CHAR{ligne%}) CASE 156 enleve_code(ligne%) vue_de_dessous|=VAL(CHAR{ligne%}) CASE 157 enleve_code(ligne%) vue_en_3d|=VAL(CHAR{ligne%}) CASE 158 enleve_code(ligne%) adr_quitter%=VAL(CHAR{ligne%}) CASE 159 enleve_code(ligne%) adr_memoire%=VAL(CHAR{ligne%}) CASE 160 enleve_code(ligne%) adr_notrouve%=VAL(CHAR{ligne%}) CASE 161 enleve_code(ligne%) adr_danger%=VAL(CHAR{ligne%}) CASE 162 enleve_code(ligne%) adr_limite%=VAL(CHAR{ligne%}) CASE 163 enleve_code(ligne%) adr_mauvaise_version%=VAL(CHAR{ligne%}) CASE 164 enleve_code(ligne%) adr_nofenetre%=VAL(CHAR{ligne%}) CASE 165 enleve_code(ligne%) adr_existe%=VAL(CHAR{ligne%}) CASE 166 enleve_code(ligne%) adr_vide%=VAL(CHAR{ligne%}) CASE 167 enleve_code(ligne%) adr_movl1%=VAL(CHAR{ligne%}) CASE 168 enleve_code(ligne%) adr_racctrou%=VAL(CHAR{ligne%}) CASE 169 enleve_code(ligne%) adr_ficinclu%=VAL(CHAR{ligne%}) CASE 170 enleve_code(ligne%) adr_no3d2%=VAL(CHAR{ligne%}) CASE 171 enleve_code(ligne%) adr_pov_def%=VAL(CHAR{ligne%}) CASE 172 enleve_code(ligne%) adr_nomimage%=VAL(CHAR{ligne%}) CASE 173 enleve_code(ligne%) adr_depasse%=VAL(CHAR{ligne%}) CASE 174 enleve_code(ligne%) adr_imprimante%=VAL(CHAR{ligne%}) CASE 175 enleve_code(ligne%) adr_memoire_visu%=VAL(CHAR{ligne%}) CASE 176 enleve_code(ligne%) objet_actif=VAL(CHAR{ligne%}) CASE 177 enleve_code(ligne%) a_charger%=VAL(CHAR{ligne%}) CASE 178 enleve_code(ligne%) xtendtos_handle&=VAL(CHAR{ligne%}) CASE 179 enleve_code(ligne%) xtendtos_fnct%=VAL(CHAR{ligne%}) CASE 180 enleve_code(ligne%) ligne_comment1%=VAL(CHAR{ligne%}) CASE 181 enleve_code(ligne%) ligne_comment2%=VAL(CHAR{ligne%}) CASE 182 enleve_code(ligne%) ligne_comment3%=VAL(CHAR{ligne%}) CASE 183 enleve_code(ligne%) ligne_comment4%=VAL(CHAR{ligne%}) CASE 184 enleve_code(ligne%) ligne_comment5%=VAL(CHAR{ligne%}) CASE 185 enleve_code(ligne%) r_resident!=VAL(CHAR{ligne%}) CASE 186 enleve_code(ligne%) f_init%=VAL(CHAR{ligne%}) CASE 187 enleve_code(ligne%) f_scalc%=VAL(CHAR{ligne%}) CASE 188 enleve_code(ligne%) fond%=VAL(CHAR{ligne%}) CASE 189 enleve_code(ligne%) fond_img!=VAL(CHAR{ligne%}) CASE 190 enleve_code(ligne%) largeur_fond%=VAL(CHAR{ligne%}) CASE 191 enleve_code(ligne%) hauteur_fond%=VAL(CHAR{ligne%}) CASE 192 enleve_code(ligne%) adr_camera%=VAL(CHAR{ligne%}) CASE 193 enleve_code(ligne%) adr_lanceur%=VAL(CHAR{ligne%}) CASE 194 enleve_code(ligne%) adr_parametres%=VAL(CHAR{ligne%}) CASE 195 enleve_code(ligne%) adr_divers%=VAL(CHAR{ligne%}) CASE 196 enleve_code(ligne%) che3d2&=VAL(CHAR{ligne%}) CASE 197 enleve_code(ligne%) chepov&=VAL(CHAR{ligne%}) CASE 198 enleve_code(ligne%) cheinc&=VAL(CHAR{ligne%}) CASE 199 enleve_code(ligne%) lin31&=VAL(CHAR{ligne%}) CASE 200 enleve_code(ligne%) lin32&=VAL(CHAR{ligne%}) CASE 201 enleve_code(ligne%) povscrip&=VAL(CHAR{ligne%}) CASE 202 enleve_code(ligne%) posangle&=VAL(CHAR{ligne%}) CASE 203 enleve_code(ligne%) lin19&=VAL(CHAR{ligne%}) CASE 204 enleve_code(ligne%) cheebs&=VAL(CHAR{ligne%}) CASE 205 enleve_code(ligne%) taille_media&=VAL(CHAR{ligne%}) CASE 206 enleve_code(ligne%) total_media&=VAL(CHAR{ligne%}) CASE 207 enleve_code(ligne%) taille_scattering&=VAL(CHAR{ligne%}) CASE 208 enleve_code(ligne%) total_scattering&=VAL(CHAR{ligne%}) CASE 209 enleve_code(ligne%) taille_density&=VAL(CHAR{ligne%}) CASE 210 enleve_code(ligne%) total_density&=VAL(CHAR{ligne%}) CASE 211 enleve_code(ligne%) include_slop_map%=VAL(CHAR{ligne%}) CASE 212 enleve_code(ligne%) include_media%=VAL(CHAR{ligne%}) CASE 213 enleve_code(ligne%) include_scattering%=VAL(CHAR{ligne%}) CASE 214 enleve_code(ligne%) include_density%=VAL(CHAR{ligne%}) CASE 215 enleve_code(ligne%) include_density_map%=VAL(CHAR{ligne%}) CASE 216 enleve_code(ligne%) nombre_de_carreaux%=VAL(CHAR{ligne%}) CASE 217 enleve_code(ligne%) pt_control%=VAL(CHAR{ligne%}) CASE 218 enleve_code(ligne%) nombre_extrude%=VAL(CHAR{ligne%}) CASE 219 enleve_code(ligne%) courbe_extrude%=VAL(CHAR{ligne%}) CASE 220 enleve_code(ligne%) nombre_de_csg%=VAL(CHAR{ligne%}) CASE 221 enleve_code(ligne%) LET liste_csg%=VAL(CHAR{ligne%}) CASE 222 enleve_code(ligne%) calque_actif|=VAL(CHAR{ligne%}) CASE 223 enleve_code(ligne%) disque_systeme%=VAL(CHAR{ligne%}) CASE 224 enleve_code(ligne%) path_systeme%=VAL(CHAR{ligne%}) CASE 225 enleve_code(ligne%) taille_transfert%=VAL(CHAR{ligne%}) CASE 226 enleve_code(ligne%) mfdb%=VAL(CHAR{ligne%}) CASE 227 enleve_code(ligne%) mfbd%=VAL(CHAR{ligne%}) CASE 228 enleve_code(ligne%) mode_entrelace!=(VAL(CHAR{ligne%})=-1) CASE 229 enleve_code(ligne%) true_color!=(VAL(CHAR{ligne%})=-1) CASE 230 enleve_code(ligne%) adr_langue%=VAL(CHAR{ligne%}) CASE 231 enleve_code(ligne%) type_de_csg&=VAL(CHAR{ligne%}) CASE 232 enleve_code(ligne%) adr_chemin_include%=VAL(CHAR{ligne%}) CASE 233 enleve_code(ligne%) zone_preview%=VAL(CHAR{ligne%}) CASE 234 enleve_code(ligne%) cheinc1&=VAL(CHAR{ligne%}) CASE 235 enleve_code(ligne%) cheinc2&=VAL(CHAR{ligne%}) CASE 236 enleve_code(ligne%) cheinc3&=VAL(CHAR{ligne%}) CASE 237 enleve_code(ligne%) cheinc4&=VAL(CHAR{ligne%}) CASE 238 enleve_code(ligne%) cheinc5&=VAL(CHAR{ligne%}) CASE 239 enleve_code(ligne%) cheinc6&=VAL(CHAR{ligne%}) CASE 240 enleve_code(ligne%) cheinc7&=VAL(CHAR{ligne%}) CASE 241 enleve_code(ligne%) cheinc8&=VAL(CHAR{ligne%}) CASE 242 enleve_code(ligne%) cheinc9&=VAL(CHAR{ligne%}) CASE 243 enleve_code(ligne%) eb_temp%=VAL(CHAR{ligne%}) CASE 244 enleve_code(ligne%) preview_24bits%=VAL(CHAR{ligne%}) CASE 245 enleve_code(ligne%) preview_compre%=VAL(CHAR{ligne%}) CASE 246 enleve_code(ligne%) roue%=VAL(CHAR{ligne%}) CASE 247 enleve_code(ligne%) largeur_roue&=VAL(CHAR{ligne%}) CASE 248 enleve_code(ligne%) hauteur_roue&=VAL(CHAR{ligne%}) CASE 249 enleve_code(ligne%) deg_gris%=VAL(CHAR{ligne%}) CASE 250 enleve_code(ligne%) largeur_deg_gris&=VAL(CHAR{ligne%}) CASE 251 enleve_code(ligne%) hauteur_deg_gris&=VAL(CHAR{ligne%}) CASE 252 enleve_code(ligne%) degigris%=VAL(CHAR{ligne%}) CASE 253 enleve_code(ligne%) largeur_degigris&=VAL(CHAR{ligne%}) CASE 254 enleve_code(ligne%) hauteur_degigris&=VAL(CHAR{ligne%}) CASE 255 enleve_code(ligne%) deg_roug%=VAL(CHAR{ligne%}) CASE 256 enleve_code(ligne%) largeur_deg_roug&=VAL(CHAR{ligne%}) CASE 257 enleve_code(ligne%) hauteur_deg_roug&=VAL(CHAR{ligne%}) CASE 258 enleve_code(ligne%) deg_vert%=VAL(CHAR{ligne%}) CASE 259 enleve_code(ligne%) largeur_deg_vert&=VAL(CHAR{ligne%}) CASE 260 enleve_code(ligne%) hauteur_deg_vert&=VAL(CHAR{ligne%}) CASE 261 enleve_code(ligne%) deg_bleu%=VAL(CHAR{ligne%}) CASE 262 enleve_code(ligne%) largeur_deg_bleu&=VAL(CHAR{ligne%}) CASE 263 enleve_code(ligne%) hauteur_deg_bleu&=VAL(CHAR{ligne%}) CASE 264 enleve_code(ligne%) objets_a_deplacer&=VAL(CHAR{ligne%}) CASE 265 enleve_code(ligne%) annul_texture%=VAL(CHAR{ligne%}) CASE 266 enleve_code(ligne%) annul_pigment%=VAL(CHAR{ligne%}) CASE 267 enleve_code(ligne%) annul_normal%=VAL(CHAR{ligne%}) CASE 268 enleve_code(ligne%) annul_finish%=VAL(CHAR{ligne%}) CASE 269 enleve_code(ligne%) annul_interior%=VAL(CHAR{ligne%}) ENDSELECT ENDIF EXIT IF termine! LOOP ENDIF CLOSE #1 ' libere(*ligne%) IF libere!=TRUE libere(*precalcul%) ENDIF ' RETURN PROCEDURE ecrire_le_fichier_de_transfert_vide OPEN "o",#2,CHAR{eb_temp%}+"\eb_model.shm" PRINT #2,"# -----------------------------------------------------------------" PRINT #2,"# Le module d'importation n'a pas trouvé d'objet ..." PRINT #2,"# -----------------------------------------------------------------" PRINT #2,"000 -1" PRINT #2,"001 -1" PRINT #2,"EOF" CLOSE #2 RETURN PROCEDURE ecrire_le_fichier_de_transfert_retour(nbo&,nbp&,adrmem%) LOCAL compteur& ' OPEN "o",#2,CHAR{eb_temp%}+"\eb_model.shm" PRINT #2,"# -----------------------------------------------------------------" IF nbo&<0 PRINT #2,"# Le module IMPOR3D2 n'a pas trouv‚ de primitive" ELSE IF nbo&>1 PRINT #2,"# Le module IMPOR3D2 a trouv‚ ";nbo&;" primitive" ELSE PRINT #2,"# Le module IMPOR3D2 a trouv‚ ";nbo&;" primitives" ENDIF ENDIF IF nbp&<0 PRINT #2,"# Le module IMPOR3D2 n'a pas trouv‚ d'objet secondaire" ELSE IF nbp&>1 PRINT #2,"# Le module IMPOR3D2 a trouv‚ ";nbp&;" objets secondaires" ELSE PRINT #2,"# Le module IMPOR3D2 a trouv‚ ";nbp&;" objets secondaires" ENDIF ENDIF PRINT #2,"# -----------------------------------------------------------------" PRINT #2,"# Nombre de primitive(s) primaire(s) trouv‚e(s) (-1 = aucune)" PRINT #2,"000 -1" PRINT #2,"# Nombre de primitive(s) secondaire(s) trouv‚e(s) (-1 = aucune)" PRINT #2,"001 ";nbp& CLR compteur& DO PRINT #2,RIGHT$("000"+STR$(ADD(compteur&,2)),3);" ";{ADD(adrmem%,SHL(compteur&,2))} INC compteur& LOOP WHILE compteur&&H20 BYTE{ADD(b%,pos%)}=0 DEC pos% LOOP RETURN f! ENDFUNC PROCEDURE enleve_code(b%) ! On enlŠve les espaces en trop CHAR{b%}=RIGHT$(CHAR{b%},SUB(LEN(CHAR{b%}),3)) b%=@enleve_caractere(b%,&H20) RETURN FUNCTION enleve_caractere(l%,car|) ! On enlŠve le caractŠre car| LOCAL pos%,lon% IF l%<>0 pos%=PRED(LEN(CHAR{l%})) DO EXIT IF BYTE{ADD(l%,pos%)}<>car| BYTE{ADD(l%,pos%)}=0 DEC pos% LOOP lon%=LEN(CHAR{l%}) DO EXIT IF BYTE{l%}<>car| BMOVE SUCC(l%),l%,PRED(lon%) BYTE{ADD(l%,PRED(lon%))}=0 DEC lon% LOOP ENDIF RETURN l% ENDFUNC ' ****************************************************************************** FUNCTION eb_temp$ LOCAL offs%,lect%,cpt% ' ' On place le A commme reference lect%=65 FOR cpt%=2 TO 25 ' IF BTST(BIOS(&HA),cpt%) IF EXIST(CHR$(ADD(lect%,cpt%))+":\eb_temp\defaut.def") RETURN CHR$(ADD(lect%,cpt%))+":\eb_temp" ENDIF ENDIF ' NEXT cpt% RETURN "VIDE" ' ENDFUNC ' ****************************************************************************** FUNCTION version(adr%) BYTE{ADD(version%,1)}=46 RETURN VAL(LEFT$(CHAR{version%},4)) ENDFUNC ' ****************************************************************************** PROCEDURE variables_diverses index_du_ressource variables_reservees_au_gem ' ++SYM blanc&=0 noir&=1 rouge&=2 vert&=3 bleu&=4 cyan&=5 jaune&=6 violet&=7 gris_clair&=8 gris_fonce&=9 rouge_pal&=10 vert_pal&=11 bleu_pal&=12 cyan_pal&=13 jaune_pal&=14 violet_pal&=15 ' ++SYM CLR taille_zone_cam_lum% CLR objet_actif& ' RETURN PROCEDURE variables_reservees_au_gem ! Celles la, elles sont pour le GEM ' ++SYM ' ---- Variables concernant les ‚vŠnements MESSAGE ---- mn_selected&=10 ! S‚lection d'un menu wm_redraw&=20 ! Demande de redessin d'‚cran wm_topped&=21 ! R‚activation d'un fenˆtre par clic wm_closed&=22 ! Fermeture d'une fenˆtre wm_fulled&=23 ! Mise en plein ‚cran d'une fenˆtre wm_arrowed&=24 ! Clic sur un des uatres champs fl‚ch‚s wm_hslid&=25 ! Changement de position du poussoir horizontal wm_vslid&=26 ! Changement de position du poussoir vertical wm_sized&=27 ! Changement de taille d'une fenˆtre wm_moved&=28 ! D‚placement d'une fenˆtre wm_newtop&=29 ! R‚activation d'une fenˆtre par femeture d'une autre ac_open&=40 ! Ouverture d'un acc‚ssoire ac_close&=41 ! Fermeture d'un accessoire ' Ajouter par moi mˆme pour la gestion des ‚l‚ments non GEM d'une fenˆtre wm_xfulled&=11 ! Bouton en pseudo 3D (plein ‚cran ou non) wm_xbutton&=12 ! Bouton en pseudo 3D (redessin par 2 objets avant) wm_xreducted&=13 ! R‚duction d'une fenˆtre wm_xmoved&=14 ! D‚placement d'une fenˆtre wm_xclosed&=15 ! Fermeture d'une fenˆtre ' ---- Variables concernant les ‚vŠnements FENETRE ---- wf_kind&=1 ! Fixe de nouvelles parties de fenˆtre wf_name&=2 ! Fixe un nom de fenˆtre wf_info&=3 ! Fixe une nouvelle info de fenˆtre wf_workxywh&=4 ! Coordonn‚es de la zone de travail de fenˆtre wf_currxywh&=5 ! Coordonnees de la zone total de fenˆtre wf_prevxywh&=6 ! Taille globale fenˆtre pr‚c‚dente wf_fullxywh&=7 ! Taille globale fenˆtre plein ‚cran wf_hslide&=8 ! Position poussoir horizontal wf_vslide&=9 ! Position poussoir vertical wf_top&=10 ! Code de fenˆtre active wf_firstxywh&=11 ! Premier rectangle de la liste des rectangles wf_nextxywh&=12 ! Prochain rectangle de la liste des rectangles wf_newdesk&=14 ! Fixe un nouvel arbre pour le bureau wf_hslize&=15 ! Fixe taille poussoir horizontal wf_vslize&=16 ! Fixe taille poussoir vertical ' ---- Variables concernant l'AES ----------------------- aes_selectable&=0 aes_default&=1 aes_exit&=2 aes_editable&=3 aes_rbutton&=4 aes_lastob&=5 aes_touchexit&=6 aes_hidetree&=7 aes_indirect&=8 ' aes_selected&=0 aes_crossed&=1 aes_checked&=2 aes_disable&=3 aes_outlined&=4 aes_shadowed&=5 ' end_update&=0 beg_update&=1 end_mctrl&=2 beg_mctrl&=3 ' ---- Pour le nouveau GEM en pseudo 3D ----------------------- aes_indicateur&=9 aes_fond&=10 ' ---- Les formes de souris et l'activation/d‚sactivation du rongeur ----- fleche&=0 trait_vertical&=1 abeille&=2 main_pointee&=3 main_a_plat&=4 reticule_mince&=5 reticule_epais&=6 contour_de_reticule&=7 user_def&=255 m_off&=256 m_on&=257 ' ---- Pour les ‚changes avec ST-GUIDE pour le moment inop‚rent ---------- ac_help&=1025 ac_reply&=1026 ac_version&=1027 ac_copy&=1028 av_sendkey&=&H4710 va_start&=&H4711 av_startprog&=&H4723 av_accwindopen&=&H4724 va_dragaccwind&=&H4725 av_accwindclosed&=&H4726 ' ++SYM RETURN PROCEDURE initialisation ! Quelques truc utils LOCAL adresse%,taille_totale% ' xmax&=INT{station%} ymax&=INT{ADD(station%,2)} maxcol&=PRED(INT{ADD(station%,26)}) plan_systeme&=INT{ADD(etendue%,8)} ecran%=((SUCC(xmax&)/8)*SUCC(ymax&)*plan_systeme&) ' ' multitache!=(WORD{{GB+4}+2}<>1) ' CLR coef,memoire_taille% ' scene_minx=3.599386269725E+308 scene_miny=3.599386269725E+308 scene_minz=3.599386269725E+308 scene_maxx=-3.599386269725E+308 scene_maxy=-3.599386269725E+308 scene_maxz=-3.599386269725E+308 ' CLR taille_totale% ADD taille_totale%,1144 ! Temporaire ADD taille_totale%,4 ! disque ADD taille_totale%,272 ! Path ADD taille_totale%,1024 ! S‚lecteur ADD taille_totale%,32 ! Mfdb ADD taille_totale%,32 ! Mfbd IF precalcul%=0 ADD taille_totale%,256 ! zonecalcul ENDIF ' zone%=@prendre(taille_totale%,FALSE,3) adresse%=zone% ' temporaire%=@zone(1144,adresse%) disque%=@zone(4,adresse%) path%=@zone(272,adresse%) tr_tmp%=@zone(1024,adresse%) mfdb%=@zone(32,adresse%) mfbd%=@zone(32,adresse%) IF precalcul%=0 precalcul%=@zone(256,adresse%) membfill(zone%,SUB(taille_totale%,256),0) ELSE membfill(zone%,taille_totale%,0) ENDIF ' RETURN FUNCTION lire_le_ressource_module ! Et un ressource, un ! ' ******************** Chargement du ressource ‚tendu ************************ CHAR{mem_che%}=CHAR{disque_systeme%}+CHAR{path_systeme%}+CHR$(0) CHAR{mem_che%}=CHAR{mem_che%}+"modules\import.rsc"+CHR$(0) minuscule(mem_che%) IF @rsrc_load(mem_che%)=0 CHAR{mem_nom%}="[3][|IMPORT.RSC non charg‚|IMPORT.RSC not loaded|][ Ok ]"+CHR$(0) ~@afficher_alerte(mem_nom%) RETURN FALSE ELSE initialiser_ressources RETURN TRUE ENDIF ENDFUNC PROCEDURE index_du_ressource ! Avec ses index bien sur ! ' ++SYM REM Indice du ressource pour IMPORT ' LET charger&=0 ! Formulaire/Dialogue LET titimp3d&=3 ! FBOXTEXT dans l'arbre CHARGER LET nom3d2&=5 ! FBOXTEXT dans l'arbre CHARGER LET p3d2nb&=7 ! FBOXTEXT dans l'arbre CHARGER LET f3d2nb&=9 ! FBOXTEXT dans l'arbre CHARGER LET sous3d2&=10 ! BOX dans l'arbre CHARGER LET chapt3d2&=11 ! BOXTEXT dans l'arbre CHARGER LET chafa3d2&=12 ! BOXTEXT dans l'arbre CHARGER LET simpl3d2&=13 ! BOXTEXT dans l'arbre CHARGER ' ++SYM RETURN PROCEDURE initialiser_ressources ! Mettre en m‚moire adresses ressources LOCAL x&,y&,w&,h& ~@rsrc_gaddr(0,charger&,adr_3d2%) form_center(adr_3d2%,x&,y&,w&,h&) RETURN PROCEDURE redraw_elem(arb%,obj&) ! Un ‚l‚ment … redessiner. C'est ici LOCAL x&,y&,w&,h&,ob& objc_offset(arb%,obj&,x&,y&) w&=OB_W(arb%,obj&) h&=OB_H(arb%,obj&) ' Pour pr‚venir les SHADOWS et les objets 3D du nouveau GEM, ‚largir le REDRAW ' de 3 pixels tout autour. objc_draw(arb%,0,12,x&,y&,w&,h&,-1) RETURN ' ***************************** Gestion des COOKIEs **************************** PROCEDURE etude_du_systeme ! Mais quelle machine est ce donc ? LOCAL super%,adr%,type%,slot%,long%,magic_cookie% magic!=FALSE mint!=FALSE geneva!=FALSE mode_naes!=FALSE gdos!=FALSE super%=GEMDOS(&H20,L:0) ! Passage en mode SUPERVISEUR adr%={&H5A0} ! Pointeur sur le premier COOKIE IF adr%<>0 CLR slot% WHILE {ADD(adr%,SHL(slot%,3))}<>0 long%={ADD(ADD(adr%,SHL(slot%,3)),4)} $S%,$S> SELECT LEFT$(CHAR{ADD(adr%,SHL(slot%,3))},4) CASE "MagX" ! Multitƒche avec MagiC magic!=TRUE CASE "Gnva" ! Multitƒche avec Geneva geneva!=TRUE CASE "MiNT" ! Multitƒche avec MiNT mint!=TRUE CASE "nAES" ! N AES mode_naes!=TRUE ENDSELECT INC slot% WEND ENDIF ~GEMDOS(&H20,L:super%) ! Retour en mode UTILISATEUR RETURN ' **************************** Gestion de la m‚moire *************************** FUNCTION prendre(tl%,id!,mode|) ! Prendre un peu de m‚moire LOCAL l%,dummy& tl%=SHL(SHR(ADD(tl%,16),4),4) IF GEMDOS(&H44,L:-1,W:0)<>-32 ! La fonction est elle acc‚pt‚e IF multitache! mod|=mod| OR &X11000 ! Force l'utilisation des informations de ENDIF ! l'entˆte l%=GEMDOS(&H44,L:tl%,W:mode|) ! L…, on est sur TT ou FALCON ELSE l%=GEMDOS(&H48,L:tl%) ! Bon, allez, les vieux appels compatibles ENDIF $S%,S> SELECT l% CASE 0 CLOSE libere(*temporaire%) ! On ‚fface les zones r‚serv‚es ~@rsrc_free ! On enlŠve le resource du module appl_exit ! et on le dit au GEM QUIT -32 ! L…, c'est la fin...snif...snif DEFAULT IF id! membfill(l%,tl%,0) ENDIF garbage_collector RETURN l% ENDSELECT ENDFUNC FUNCTION memoire_dispo(mod|) ! Reste-t-il de la m‚moire IF GEMDOS(&H44,L:-1,W:0)<>-32 ! La fonction est elle accept‚e RETURN GEMDOS(&H44,L:-1,W:mod|) ! Sur TT/FALCON, nouvel appel ELSE RETURN GEMDOS(&H48,L:-1) ! Sinon, vieux appels compatibles ENDIF ENDFUNC PROCEDURE libere(ad%) ! On rend la m‚moire … la machine IF ad%>0 $S%,S> SELECT {ad%} CASE 0 ' Ne rien faire DEFAULT ~GEMDOS(&H49,L:{ad%}) {ad%}=0 ENDSELECT ENDIF garbage_collector RETURN PROCEDURE membfill(vide_adr%,size%,sq%) ! Remplissage et vidage de bloc LOCAL dep_vi%,fin_vi%,nombre% LOCAL adr%,fin_adr% adr%=precalcul% fin_adr%=ADD(adr%,256) DO {adr%}=sq% ADD adr%,4 LOOP WHILE adr%1 CHAR{sel%}=MID$(CHAR{{obspec%}},SUCC(RINSTR(CHAR{{obspec%}},"\")),LEN(LEFT$(CHAR{{obspec%}},RINSTR(CHAR{{obspec%}},"\"))))+CHR$(0) ELSE CHAR{sel%}=RIGHT$(CHAR{{obspec%}},SUB(LEN(CHAR{{obspec%}}),3))+CHR$(0) ENDIF IF INSTR(CHAR{sel%},".") CHAR{masque%}=RIGHT$(CHAR{sel%},SUB(LEN(CHAR{sel%}),INSTR(CHAR{sel%},".")))+CHR$(0) ENDIF ENDIF minuscule(sel%) minuscule(masque%) minuscule(msq%) extend(sel%,masque%,sel%) IF sel! IF magic! AND (INSTR(CHAR{sel%},".")=0) ! Allez, les nom longs de MagiC! fslx_do(sel%,liin%) ELSE IF INT{ADD({ADD(GB,4)},0)}<&H140 ! Ancien GEM/TOS... @selecteur(sel%) ELSE ! Sinon le nouveau selecteur IF liin%<>-1 @xselecteur(sel%,liin%) ELSE @selecteur(sel%) ENDIF ENDIF IF CHAR{masque%}<>"*" extend(sel%,masque%,sel%) ENDIF ENDIF ENDIF minuscule(sel%) minuscule(masque%) minuscule(msq%) minuscule(disque%) minuscule(path%) RETURN PROCEDURE selecteur(sel%) ' CHAR{mem_che%}=CHAR{disque%}+CHAR{path%}+"*."+CHAR{masque%}+CHR$(0) ' INT{ADD(GCONTRL,2)}=0 INT{ADD(GCONTRL,4)}=2 INT{ADD(GCONTRL,6)}=2 INT{ADD(GCONTRL,8)}=0 ' {ADDRIN}=mem_che% {ADD(ADDRIN,4)}=sel% ' GEMSYS 90 ' IF INT{ADD(GINTOUT,2)}=1 CHAR{disque%}=LEFT$(CHAR{mem_che%},2) CHAR{path%}=RIGHT$(LEFT$(CHAR{mem_che%},RINSTR(CHAR{mem_che%},"\")),SUB(LEN(LEFT$(CHAR{mem_che%},RINSTR(CHAR{mem_che%},"\"))),2))+CHR$(0) ELSE membfill(sel%,LEN(CHAR{sel%}),0) ENDIF ' RETURN PROCEDURE xselecteur(sel%,liin%) ' CHAR{mem_che%}=CHAR{disque%}+CHAR{path%}+"*."+CHAR{masque%}+CHR$(0) ' INT{ADD(GCONTRL,2)}=0 INT{ADD(GCONTRL,4)}=2 INT{ADD(GCONTRL,6)}=3 INT{ADD(GCONTRL,8)}=0 ' {ADDRIN}=mem_che% ! Chemin {ADD(ADDRIN,4)}=sel% ! Nom du fichier {ADD(ADDRIN,8)}=liin% ! Texte d'information ' GEMSYS &H5B ' IF INT{ADD(GINTOUT,2)}=1 CHAR{disque%}=LEFT$(CHAR{mem_che%},2) CHAR{path%}=RIGHT$(LEFT$(CHAR{mem_che%},RINSTR(CHAR{mem_che%},"\")),SUB(LEN(LEFT$(CHAR{mem_che%},RINSTR(CHAR{mem_che%},"\"))),2))+CHR$(0) ELSE membfill(sel%,LEN(CHAR{sel%}),0) ENDIF ' RETURN PROCEDURE fslx_do(sel%,liin%) LOCAL t%,fsd% ' Nouvelle fonction de s‚lecteur de fichier pour MagiC! et les noms longs ' tir‚ des travaux de Pierre THONTAT (Rajha LONE de QUEEN MEKA, merci … lui). ' IF CHAR{path%}="" CHAR{tr_tmp%}=CHAR{disque%}+"\"+CHR$(0) CHAR{mem_che%}=CHAR{disque%}+"\"+CHR$(0)+CHR$(0) ELSE CHAR{tr_tmp%}=CHAR{disque%}+CHAR{path%}+CHR$(0) CHAR{mem_che%}=CHAR{disque%}+CHAR{path%}+CHR$(0)+CHR$(0) ENDIF IF CHAR{path_systeme%}="" CHAR{tr_tmp%}=CHAR{tr_tmp%}+CHR$(0)+CHAR{disque_systeme%}+"\"+CHR$(0) ELSE CHAR{tr_tmp%}=CHAR{tr_tmp%}+CHR$(0)+CHAR{disque_systeme%}+CHAR{path_systeme%}+CHR$(0) ENDIF CHAR{tr_tmp%}=CHAR{tr_tmp%}+CHR$(0)+"u:\"+CHR$(0)+CHR$(0) ' CHAR{tr_tmp%}=CHAR{tr_tmp%}+CHR$(0)+"u:\bin\"+CHR$(0) ' CHAR{tr_tmp%}=CHAR{tr_tmp%}+CHR$(0)+"u:\dev\"+CHR$(0) ' CHAR{tr_tmp%}=CHAR{tr_tmp%}+CHR$(0)+"c:\clipbrd\"+CHR$(0)+CHR$(0) ' CHAR{masque%}="*"+CHR$(0)+"*."+CHAR{masque%}+CHR$(0)+CHR$(0) ' ' tr_tmp% est une chaine se terminant par deux octets NULL. ' avec tout ses paramŠtres INT{ADD(GCONTRL,2)}=4 ! Nombre d'entr‚es dans GINTIN INT{ADD(GCONTRL,4)}=4 ! Nombre d'entr‚es dans GINTOUT INT{ADD(GCONTRL,6)}=6 ! Nombre d'entr‚es dans ADDRIN INT{ADD(GCONTRL,8)}=2 ! Nombre d'entr‚es dans ADDROUT ' INT{GINTIN}=128 ! longueur du chemin dans le s‚lecteur INT{ADD(GINTIN,2)}=33 ! longueur nom de fichier dans le du s‚lecteur INT{ADD(GINTIN,4)}=0 ! Type de tri (0 = par nom) INT{ADD(GINTIN,6)}=8 ! Flags (8 = GETMULTI) ' {ADDRIN}=liin% ! titre de la boite {ADD(ADDRIN,4)}=mem_che% ! nom du chemin {ADD(ADDRIN,8)}=sel% ! nom du fichier sans le chemin {ADD(ADDRIN,12)}=masque% ! masques possibles {ADD(ADDRIN,16)}=0 ! Filtre {ADD(ADDRIN,20)}=tr_tmp% ! chemins par d‚faut ' GEMSYS &HC2 ! L…, c'est en fait un fslx_do() ' fsd%={ADDROUT} ! on r‚cupŠre un identificateur qui ' pour fermer le s‚lecteur (c'est un handle) IF INT{ADD(GINTOUT,2)}=1 ! si l'appel a march‚ ' on r‚cupŠre le nom de fichier, le disque et le chemin CHAR{disque%}=LEFT$(CHAR{mem_che%},2)+CHR$(0) CHAR{path%}=RIGHT$(LEFT$(CHAR{mem_che%},RINSTR(CHAR{mem_che%},"\")),SUB(LEN(LEFT$(CHAR{mem_che%},RINSTR(CHAR{mem_che%},"\"))),2))+CHR$(0) ELSE ' Sinon, on vide le nom de fichier BYTE{sel%}=0 ENDIF ' IF INT{GINTOUT} ! on referme proprement l'appel INT{ADD(GCONTRL,2)}=0 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 ' {ADDRIN}=fsd% ' GEMSYS &HBF ! L…, c'est en fait un fslx_close() ENDIF ' RETURN PROCEDURE chemin_systeme_module ' ------------------------------------------------------------------------ ' Si SELECTRIC est install‚, il va effectu‚ des changments de chemins ! ' intenpestifs (par des CHDIR/CHDRIVE), il faut donc inp‚rativement ! ' remettre tout en l'‚tat pour que tout aille bien. ! ' ------------------------------------------------------------------------ ' Remettre le lecteur systeme ! ~GEMDOS(&HE,lecteur%) ! ' ! ' Remettre le chemin systŠme ! ~GEMDOS(&H3B,L:path_systeme%) ! ' ------------------------------------------------------------------------ RETURN PROCEDURE pdomain(pdomain&) IF multitache! ~GEMDOS(&H119,W:pdomain&) ENDIF RETURN PROCEDURE minuscule(nn%) IF multitache! CHAR{nn%}=CHAR{@lower(nn%)}+CHR$(0) ELSE CHAR{nn%}=UPPER$(CHAR{nn%})+CHR$(0) ENDIF RETURN ' ************ V‚rification des extensions et cr‚ation des backups ************* PROCEDURE extend(pr%,ex%,VAR ps%) LOCAL nl%,dn%,i&,j& IF (INSTR(CHAR{pr%},".")=0 AND LEN(CHAR{pr%})<9) OR (INSTR(CHAR{pr%},".")<>0) IF INSTR(CHAR{pr%},".")=0 AND LEN(CHAR{pr%})>0 i&=LEN(CHAR{pr%}) BYTE{ADD(pr%,i&)}=ASC(".") FOR j&=SUCC(i&) TO ADD(i&,3) BYTE{ADD(pr%,j&)}=BYTE{ADD(ex%,SUB(j&,SUCC(i&)))} NEXT j& ENDIF IF RIGHT$(CHAR{pr%})<>"\" AND RIGHT$(CHAR{pr%},5)<>"\."+CHAR{ex%} AND CHAR{pr%}>"" dn%=@prendre(260,TRUE,3) FOR i&=LEN(CHAR{pr%}) DOWNTO 1 EXIT IF BYTE{ADD(pr%,i&)}=92 INC nl% NEXT i& CHAR{dn%}=RIGHT$(CHAR{pr%},nl%) IF INSTR(CHAR{dn%},".")=0 CHAR{ps%}=CHAR{pr%}+"."+CHAR{ex%}+CHR$(0) CHAR{dn%}=CHAR{dn%}+"."+CHAR{ex%}+CHR$(0) ENDIF IF RIGHT$(CHAR{dn%},4)<>"."+CHAR{ex%} IF LEFT$(CHAR{dn%},2)<>"\." CHAR{ps%}=LEFT$(CHAR{pr%},LEN(CHAR{pr%})-nl%)+LEFT$(CHAR{dn%},INSTR(CHAR{dn%},"."))+CHAR{ex%} ELSE membfill(ps%,LEN(CHAR{ps%}),0) ENDIF ELSE CHAR{ps%}=LEFT$(CHAR{pr%},LEN(CHAR{pr%})-nl%)+CHAR{dn%} ENDIF libere(*dn%) ELSE membfill(ps%,LEN(CHAR{ps%}),0) ENDIF ENDIF RETURN PROCEDURE backup(pr%,ex%) LOCAL xn% IF @s_exist(pr%) AND backup!=TRUE xn%=@prendre(260,TRUE,3) extend(pr%,ex%,xn%) IF CHAR{xn%}<>"" IF @s_exist(xn%) ~GEMDOS(&H41,L:xn%) ENDIF NAME CHAR{pr%} AS CHAR{xn%} ENDIF libere(*xn%) ENDIF RETURN ' ****************************************************************************** FUNCTION s_exist(n_n%) LOCAL ok& ' Nouvelle fonction de test d'existance d'un fichier d'aprŠs les travaux ' de Pierre THONTAT (Rajha LONE de QUEEN MEKA, merci … lui) et permettant ' la gestion des noms longs des systŠmes multitƒches. $F% ' minuscule(n_n%) ' IF (LEN(CHAR{n_n%})=0) OR (BYTE{n_n%}=0) ! Ligne vide, on repart. RETURN FALSE ELSE ok&=GEMDOS(&H3D,L:n_n%,W:0) ! On ouvre le fichier IF ok&>0 ! si c'est positif ~GEMDOS(&H3E,W:ok&) ! on renferme RETURN TRUE ! et on dit que c'est bon ELSE ! sinon, il y a un problŠme RETURN FALSE ! on dit qu'il n'y a rien ENDIF ENDIF ENDFUNC ' ****************************************************************************** PROCEDURE environnement_mono ! La, le ressource est monochrome rsrc_color(adr_3d2%,noir&,4) RETURN PROCEDURE environnement_coul ! Ah ! la, il est en couleurs rsrc_color(adr_3d2%,gris_clair&,7) RETURN PROCEDURE rsrc_color(arb%,coul&,tram_des&) LOCAL c%,type&,type_suivant&,pc%,ob_spec%,te_color&,acoul& ' acoul&=coul& pc%=OB_TAIL(arb%,0) ! Combien d'enfants ?? WHILE pc%<>-1 ! Recherche du dernier enfant pcf%=pc% pc%=OB_TAIL(arb%,pcf%) WEND ! Ok on est au dernier INC pcf% CLR c% DO type&=OB_TYPE(arb%,c%) ! Recherche du type de l'‚l‚ment ' -------------------------------------------------------------------------- ' L…, j'ai enfin compris pourquoi sous MagiC! la 3D de mes ressources ' n'‚tait pas bonne. En fait, si un objet est s‚lectionn‚ avec l'un des ' flags 3D activ‚, alors, il est consid‚r‚ par MagiC! comme un objet 3D ' invers‚. Et ‡a ! EB_MODEL n'aime pas du tout. Il me faut donc enlever ' les flags de s‚lection des deux objets formant la 3D de EB_MODEL, mais ' cela uniquement sous MagiC! IF magic! IF c% SELECT type& CASE g_box&,g_ibox&,g_boxchar& IF BTST(OB_FLAGS(arb%,c%),aes_indicateur&) OR BTST(OB_FLAGS(arb%,c%),aes_fond&) IF (NOT @un_flacon) OR (arb%=adr_fenetre% AND ((c%=fenvue07&) OR (c%=fenvue27&) OR (c%=fenvue37&) OR (c%=fenvue47&))) OR (maxcol&<4) ob_spec%=ob_spec% AND -128 ob_spec%=ob_spec% OR SHL(tram_des&,4) ! Nouvelle trame ob_spec%=ob_spec% OR coul& ! Nouvelle couleur OB_SPEC(arb%,c%)=ob_spec% ENDIF IF (arb%=adr_fenetre%) AND ((c%=fenvue07&) OR (c%=fenvue27&) OR (c%=fenvue37&) OR (c%=fenvue47&)) ' ' Comme dit plus haut, l…, il faut enlever le flag que l'on a forcer. ob_flags(arb%,c%,aes_fond&,FALSE) ' ENDIF ENDIF CASE g_text&,g_boxtext&,g_fboxtext& IF BTST(OB_FLAGS(arb%,c%),aes_indicateur&) OR BTST(OB_FLAGS(arb%,c%),aes_fond&) IF (NOT @un_flacon) OR (maxcol&<4) te_color&=INT{ADD(ob_spec%,18)} te_color&=te_color& AND -128 te_color&=te_color& OR SHL(tram_des&,4) ! Nouvelle trame te_color&=te_color& OR coul& ! Nouvelle couleur INT{ADD(ob_spec%,18)}=te_color& ENDIF ENDIF ENDSELECT INC c% LOOP WHILE c%0 set_fill_interior_style(t&) set_user_defined_fill_pattern(adr%) ELSE IF t&>-1 set_fill_interior_style(t&) ENDIF IF m&>-1 set_fill_style_index(m&) ENDIF ENDIF IF c&>-1 IF true_color! inquire_color_representation(c&,r&,v&,b&,vdihandle%) set_color_representation(254,r&,v&,b&,vdihandle%) set_fill_color_index(254) ELSE set_fill_color_index(c&) ENDIF ENDIF RETURN PROCEDURE set_text_mode(col&,atr&,ang&,hau&,fon&,hand%) LOCAL r&,v&,b& IF true_color! inquire_color_representation(col&,r&,v&,b&,hand%) set_color_representation(254,r&,v&,b&,hand%) set_graphic_text_color_index(254,hand%) ELSE set_graphic_text_color_index(col&,hand%) ENDIF set_graphic_text_special_effects(atr&,hand%) set_character_baseline_vector(ang&) set_text_face(fon&,hand%) set_character_height(hau&,hand%) RETURN ' ************************ Sous proc‚dure utilisant la VDI ******************** PROCEDURE clear_workstation ! VDI 3 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=0 INT{ADD(CONTRL,12)}=vdihandle% VDISYS 3 RETURN PROCEDURE update_workstation ! VDI 4 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=0 INT{ADD(CONTRL,12)}=vdihandle% VDISYS 4 RETURN PROCEDURE polyline(nb&) ! VDI 6 INT{ADD(CONTRL,2)}=SUCC(nb&) INT{ADD(CONTRL,6)}=0 INT{ADD(CONTRL,12)}=vdihandle% bmove(emu_xten%,PTSIN,SHL(SUCC(nb&),2)) VDISYS 6 RETURN PROCEDURE polymarker(nb&) ! VDI 7 INT{ADD(CONTRL,2)}=SUCC(nb&) INT{ADD(CONTRL,6)}=0 INT{ADD(CONTRL,12)}=vdihandle% bmove(emu_xten%,PTSIN,SHL(SUCC(nb&),2)) VDISYS 7 RETURN PROCEDURE text(px%,py%,t%) ! VDI 8 LOCAL i& INT{ADD(CONTRL,2)}=1 INT{ADD(CONTRL,6)}=LEN(CHAR{t%}) INT{ADD(CONTRL,12)}=vdihandle% INT{PTSIN}=px% INT{ADD(PTSIN,2)}=py% CLR i& DO INT{ADD(INTIN,SHL(i&,1))}=BYTE{ADD(t%,i&)} INC i& LOOP WHILE i& SELECT fnct| CASE 1,8,9 ! Bar, Rounded rectangle, Filled rounded rectangle INT{ADD(CONTRL,6)}=0 INT{PTSIN}=cx& INT{ADD(PTSIN,2)}=cy& INT{ADD(PTSIN,4)}=ox& INT{ADD(PTSIN,6)}=oy& CASE 5 ! Ellipse INT{ADD(CONTRL,6)}=0 INT{PTSIN}=cx& INT{ADD(PTSIN,2)}=cy& INT{ADD(PTSIN,4)}=rayx& INT{ADD(PTSIN,6)}=rayy& CASE 6,7 ! Elliptical arc, Elliptical pie INT{ADD(CONTRL,6)}=2 INT{INTIN}=ang0& INT{ADD(INTIN,2)}=ang1& INT{PTSIN}=cx& INT{ADD(PTSIN,2)}=cy& INT{ADD(PTSIN,4)}=rayx& INT{ADD(PTSIN,6)}=rayy& ENDSELECT VDISYS 11 graf_mouse(m_on&,0) RETURN PROCEDURE set_character_height(h_d_t&,hand%) ! VDI 12 INT{ADD(CONTRL,2)}=1 INT{ADD(CONTRL,6)}=0 INT{ADD(CONTRL,12)}=hand% INT{PTSIN}=0 INT{ADD(PTSIN,2)}=h_d_t& VDISYS 12 RETURN PROCEDURE set_character_baseline_vector(a_d_t&) ! VDI 13 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=a_d_t& VDISYS 13 RETURN PROCEDURE set_color_representation(index&,r&,v&,b&,hand%) ! VDI 14 ' set_color_representation Fonction 14 de la VDI INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=4 INT{ADD(CONTRL,12)}=hand% INT{INTIN}=index& INT{ADD(INTIN,2)}=r& INT{ADD(INTIN,4)}=v& INT{ADD(INTIN,6)}=b& VDISYS 14 RETURN PROCEDURE set_polyline_type(t_d_l%) ! VDI 15 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=t_d_l% VDISYS 15 RETURN PROCEDURE set_polyline_line_witdh(l_d_l&) ! VDI 16 INT{ADD(CONTRL,2)}=1 INT{ADD(CONTRL,6)}=0 INT{ADD(CONTRL,12)}=vdihandle% INT{PTSIN}=l_d_l& INT{ADD(PTSIN,2)}=0 VDISYS 16 RETURN PROCEDURE set_polyline_color_index(c_d_l&) ! VDI 17 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=c_d_l& VDISYS 17 RETURN PROCEDURE set_polymarker_type(c_d_m&) ! VDI 18 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=c_d_m& VDISYS 18 RETURN PROCEDURE set_polymarker_height(c_d_m&) ! VDI 19 INT{ADD(CONTRL,2)}=1 INT{ADD(CONTRL,6)}=0 INT{ADD(CONTRL,12)}=vdihandle% INT{PTSIN}=0 INT{ADD(PTSIN,2)}=c_d_m& VDISYS 19 RETURN PROCEDURE set_polymarker_color_index(c_d_m&) ! VDI 20 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=c_d_m& VDISYS 20 RETURN PROCEDURE set_text_face(f_d_t&,hand%) ! VDI 21 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=hand% INT{INTIN}=f_d_t& VDISYS 21 RETURN PROCEDURE set_graphic_text_color_index(c_d_t&,hand%) ! VDI 22 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=hand% INT{INTIN}=c_d_t& VDISYS 22 RETURN PROCEDURE set_fill_interior_style(s_d_r|) ! VDI 23 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=s_d_r| VDISYS 23 RETURN PROCEDURE set_fill_style_index(i_d_r|) ! VDI 24 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=i_d_r| VDISYS 24 RETURN PROCEDURE set_fill_color_index(c_d_r&) ! VDI 25 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=c_d_r& VDISYS 25 RETURN PROCEDURE inquire_color_representation(index&,VAR r&,v&,b&,hand%) ! VDI 26 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=2 INT{ADD(CONTRL,12)}=hand% INT{INTIN}=index& INT{ADD(INTIN,2)}=0 ! 0=couleurs d‚finies 1=composition physique ' effectivement r‚alis‚ VDISYS 26 r&=INT{ADD(INTOUT,2)} v&=INT{ADD(INTOUT,4)} b&=INT{ADD(INTOUT,6)} RETURN PROCEDURE input_locator(mx&,my&) ! VDI 28 INT{ADD(CONTRL,2)}=1 INT{ADD(CONTRL,6)}=0 INT{ADD(CONTRL,12)}=vdihandle% INT{PTSIN}=mx& INT{ADD(PTSIN,2)}=my& VDISYS 28 RETURN PROCEDURE set_writing_mode(mode_de_dessin|) ! VDI 32 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=mode_de_dessin| VDISYS 32 RETURN PROCEDURE set_input_mode(mode&) ! VDI 33 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=2 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=1 ! Mode 'LOCATOR' (la souris quoi !) INT{ADD(INTIN,2)}=mode& VDISYS 33 RETURN PROCEDURE set_graphic_text_alignment(p_h&,p_v&,hand%) ! VDI 39 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=2 INT{ADD(CONTRL,12)}=hand% INT{INTIN}=p_h& INT{ADD(INTIN,2)}=p_v& VDISYS 39 RETURN PROCEDURE open_virtuel_screen_workstation(ncndc|) ! VDI 100 LOCAL nb&,i& INT{ADD(CONTRL,2)}=0 ! Longueur du tableau PTSIN INT{ADD(CONTRL,6)}=11 ! Longueur du tableau INTIN ' Ren‚ DEPEINT … cherch‚ sur son TT pourquoi cela ne fonctionnait pas ' avec sa carte MATRIX. AprŠs pas mal de temps, il a fini par d‚couvrir ' que le driver de la carte avait besoin d'une valeur dans CONTRL(6) ' Pour ˆtre propre, nous allons donc y placer l'AP_ID de l'application. ' Et ben non. Pierre THONTAT … trouv‚ dans le COMPENDIUM ce qu'il fallait ' mettre … cet endroit. C'est en fait la valeur retourn‚e par GRAF_HANDLE; INT{ADD(CONTRL,12)}=@graf_handle(i&,i&,i&,i&) ' Merci … Ren‚ et … Pierre... INT{INTIN}=1 ! Num‚ro ID du p‚riph‚rique physique (‚cran) INT{ADD(INTIN,2)}=1 ! Type de ligne INT{ADD(INTIN,4)}=1 ! Index de couleur Polyline INT{ADD(INTIN,6)}=1 ! Type de marqueur INT{ADD(INTIN,8)}=1 ! Index de couleur Polymarker INT{ADD(INTIN,10)}=1 ! Fonte de caractŠres INT{ADD(INTIN,12)}=1 ! Index couleur texte INT{ADD(INTIN,14)}=1 ! Fill interior Style INT{ADD(INTIN,16)}=1 ! Fill style index INT{ADD(INTIN,18)}=1 ! Fill index couleur INT{ADD(INTIN,20)}=ncndc| ! Flag coordonn‚es NDC ou RC VDISYS 100 nb&=INT{ADD(CONTRL,8)} vdihandle%=INT{ADD(CONTRL,12)} station%=@prendre(SHL(nb&,1),FALSE,3) CLR i& DO INT{ADD(station%,SHL(i&,1))}=INT{ADD(INTOUT,MUL(i&,2))} INC i& LOOP WHILE i&0 ! L'‚cran, C'est au GEM de bosser INT{ADD(mfdb%,4)}=sl& ! Largeur en points du raster entier INT{ADD(mfdb%,6)}=sh& ! Hauteur en points du raster entier INT{ADD(mfdb%,8)}=sl&\16 ! Largeur en mots du raster entier IF mode_entrelace! INT{ADD(mfdb%,10)}=1 ! flag standart (cons‚cutif) ELSE INT{ADD(mfdb%,10)}=-1*(sp&=1) ! flag standart (cons‚qutif en mono) ENDIF ! ou sp‚cifique (entrelac‚ en couleur) INT{ADD(mfdb%,12)}=sp& ! Nombre de niveaux de couleurs ENDIF ' ' D‚finition du bloc raster cible (MFBD): {mfbd%}=d% ! Adresse de la m‚moire SOURCE IF d%<>0 ! L'‚cran, C'est au GEM de bosser INT{ADD(mfbd%,4)}=dl& ! Largeur en points du raster entier INT{ADD(mfbd%,6)}=dh& ! Hauteur en points du raster entier INT{ADD(mfbd%,8)}=dl&\16 ! Largeur en mots du raster entier IF mode_entrelace! INT{ADD(mfbd%,10)}=1 ! flag standart (cons‚cutif) ELSE INT{ADD(mfbd%,10)}=-1*(dp&=1) ! flag standart (cons‚qutif en mono) ENDIF ! ou sp‚cifique (entrelac‚ en couleur) INT{ADD(mfbd%,12)}=dp& ! Nombre de niveaux de couleurs ENDIF ' INT{ADD(CONTRL,2)}=4 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% {ADD(CONTRL,14)}=mfdb% {ADD(CONTRL,18)}=mfbd% INT{INTIN}=mod| ! Mode de copie de 0 … 15 ' INT{PTSIN}=x11& ! X en haut … gauche source INT{ADD(PTSIN,2)}=y11& ! Y en haut … gauche source INT{ADD(PTSIN,4)}=x12& ! X en bas … droite source INT{ADD(PTSIN,6)}=y12& ! Y en bas … droite source INT{ADD(PTSIN,8)}=x21& ! X en haut … gauche destination INT{ADD(PTSIN,10)}=y21& ! Y en haut … gauche destination INT{ADD(PTSIN,12)}=x22& ! X en bas … droite destination INT{ADD(PTSIN,14)}=y22& ! Y en bas … droite destination VDISYS 109 graf_mouse(m_on&,0) ' RETURN PROCEDURE transform_form(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&) ! VDI 110 ' Fonction VDI Nø 110 (TRANSFORM FORM) ' Copie de raster standard vers raster sp‚cifique ' D‚finition du bloc raster source (MFDB): {mfdb%}=s% ! Adresse de la m‚moire SOURCE IF s%<>0 ! L'‚cran, C'est au GEM de bosser INT{ADD(mfdb%,4)}=sl& ! Largeur en points du raster entier INT{ADD(mfdb%,6)}=sh& ! Hauteur en points du raster entier INT{ADD(mfdb%,8)}=sl&\16 ! Largeur en mots du raster entier INT{ADD(mfbd%,10)}=-1*(sp&=1) ! flag standart (cons‚qutif en mono) INT{ADD(mfdb%,12)}=sp& ! Nombre de niveaux de couleurs ENDIF ' ' D‚finition du bloc raster cible (MFBD): {mfbd%}=d% ! Adresse de la m‚moire SOURCE IF d%<>0 ! L'‚cran, C'est au GEM de bosser INT{ADD(mfbd%,4)}=dl& ! Largeur en points du raster entier INT{ADD(mfbd%,6)}=dh& ! Hauteur en points du raster entier INT{ADD(mfbd%,8)}=dl&\16 ! Largeur en mots du raster entier INT{ADD(mfbd%,10)}=-1*(dp&=1) ! flag standart (cons‚qutif en mono) INT{ADD(mfbd%,12)}=dp& ! Nombre de niveaux de couleurs ENDIF ' INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=0 INT{ADD(CONTRL,12)}=vdihandle% {ADD(CONTRL,14)}=mfdb% {ADD(CONTRL,18)}=mfbd% VDISYS 110 ' RETURN PROCEDURE set_mouse_form(p_h&) ! VDI 111 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=37 INT{ADD(CONTRL,12)}=vdihandle% bmove(ADD(form_mouse%,MUL(p_h&,74)),INTIN,74) VDISYS 111 RETURN PROCEDURE set_user_defined_fill_pattern(adr%) ! VDI 112 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=16 INT{ADD(CONTRL,12)}=vdihandle% bmove(adr%,INTIN,32) VDISYS 112 RETURN PROCEDURE set_user_defined_line_style_pattern(e_d_l%) ! VDI 113 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=e_d_l% VDISYS 113 RETURN ' ! VDI 116 PROCEDURE inquire_text_extend(t%,hand%,VAR x1&,y1&,x2&,y2&,x3&,y3&,x4&,y4&) LOCAL i& INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,4)}=4 INT{ADD(CONTRL,6)}=LEN(CHAR{t%}) INT{ADD(CONTRL,8)}=0 INT{ADD(CONTRL,12)}=hand% CLR i& DO INT{ADD(INTIN,SHL(i&,1))}=BYTE{ADD(t%,i&)} INC i& LOOP WHILE i&0 ! L'‚cran, C'est au GEM de bosser INT{ADD(mfdb%,4)}=sl& ! Largeur en points du raster entier INT{ADD(mfdb%,6)}=sh& ! Hauteur en points du raster entier INT{ADD(mfdb%,8)}=sl&\16 ! Largeur en mots du raster entier INT{ADD(mfbd%,10)}=-1*(sp&=1) ! flag standart (cons‚qutif en mono) INT{ADD(mfdb%,12)}=sp& ! Nombre de niveaux de couleurs ENDIF ' ' D‚finition du bloc raster cible (MFBD): {mfbd%}=d% ! Adresse de la m‚moire SOURCE IF d%<>0 ! L'‚cran, C'est au GEM de bosser INT{ADD(mfbd%,4)}=dl& ! Largeur en points du raster entier INT{ADD(mfbd%,6)}=dh& ! Hauteur en points du raster entier INT{ADD(mfbd%,8)}=dl&\16 ! Largeur en mots du raster entier INT{ADD(mfbd%,10)}=-1*(dp&=1) ! flag standart (cons‚qutif en mono) INT{ADD(mfbd%,12)}=dp& ! Nombre de niveaux de couleurs ENDIF ' INT{ADD(CONTRL,2)}=4 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% {ADD(CONTRL,14)}=mfdb% {ADD(CONTRL,18)}=mfbd% INT{INTIN}=3 ! Mode REMPLACE ' INT{PTSIN}=x11& ! X en haut … gauche source INT{ADD(PTSIN,2)}=y11& ! Y en haut … gauche source INT{ADD(PTSIN,4)}=x12& ! X en bas … droite source INT{ADD(PTSIN,6)}=y12& ! Y en bas … droite source INT{ADD(PTSIN,8)}=x21& ! X en haut … gauche destination INT{ADD(PTSIN,10)}=y21& ! Y en haut … gauche destination INT{ADD(PTSIN,12)}=x22& ! X en bas … droite destination INT{ADD(PTSIN,14)}=y22& ! Y en bas … droite destination VDISYS 121 graf_mouse(m_on&,0) ' RETURN PROCEDURE sample_mouse_button_state(VAR mx&,my&,mk&) ! VDI 124 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=0 INT{ADD(CONTRL,12)}=vdihandle% VDISYS 124 mk&=INT{INTOUT} mx&=INT{PTSOUT} my&=INT{ADD(PTSOUT,2)} RETURN PROCEDURE set_clipping_rectangle(flags|,cx&,cy&,ox&,oy&,fx&,fy&) ! VDI 129 cx&=MAX(cx&,fx&) cy&=MAX(cy&,fy&) INT{ADD(CONTRL,2)}=2 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=flags| INT{PTSIN}=cx& INT{ADD(PTSIN,2)}=cy& INT{ADD(PTSIN,4)}=ox& INT{ADD(PTSIN,6)}=oy& VDISYS 129 RETURN PROCEDURE inquire_face_name_and_index(num&) ! VDI 130 LOCAL i&,adr% INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=num& VDISYS 130 adr%=ADD(nom_des_fontes%,MUL(PRED(num&),36)) INT{adr%}=INT{ADD(INTOUT,66)} INT{ADD(adr%,2)}=INT{INTOUT} CLR i& DO BYTE{ADD(ADD(adr%,4),i&)}=INT{ADD(ADD(INTOUT,2),SHL(i&,1))} INC i& LOOP WHILE i&<32 RETURN PROCEDURE set_outline_fonte_fkew(ang%) ! VDI 253 INT{ADD(CONTRL,2)}=0 INT{ADD(CONTRL,6)}=1 INT{ADD(CONTRL,12)}=vdihandle% INT{INTIN}=ang% VDISYS 253 RETURN ' ****************************************************************************** ' **** **** ' **** Proc‚dures des fonctions AES par appels r‚els de l'AES **** ' **** **** ' ****************************************************************************** ' ************************ Sous proc‚dure utilisant l'AES ********************** FUNCTION appl_init ! 10 RETURN WORD{ADD({ADD(GB,4)},4)} ENDFUNC FUNCTION appl_read(ap_rid&,ap_rlength&,ap_rpbuff%) ! 11 INT{ADD(GCONTRL,2)}=2 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=ap_rid& INT{ADD(GINTIN,2)}=ap_rlength& {ADDRIN}=ap_rpbuff% GEMSYS 11 RETURN INT{GINTOUT} ENDFUNC PROCEDURE appl_write(ap_wid&,ap_wlength&,ap_wpbuff%) ! 12 INT{ADD(GCONTRL,2)}=2 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=ap_wid& INT{ADD(GINTIN,2)}=ap_wlength& {ADDRIN}=ap_wpbuff% GEMSYS 12 RETURN FUNCTION appl_find(ap_fpname%) ! 13 INT{ADD(GCONTRL,2)}=0 ! 2 sous TOS | 0 sous MAGIC INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 {ADDRIN}=ap_fpname% GEMSYS 13 RETURN INT{GINTOUT} ENDFUNC PROCEDURE appl_exit ! 19 ' GEMSYS 19 RETURN PROCEDURE appl_startprog(prg%,cmd%) ! Gregor ' INT{buf%}=av_startprog& ! Num‚ro du message INT{ADD(buf%,2)}=ap_id& ! Indentificateur exp‚diteur du message INT{ADD(buf%,4)}=0 ! Pas d'exc‚dent au message {ADD(buf%,6)}=prg% ! Adresse de la chaine "nom du programme" {ADD(buf%,10)}=cmd% ! Adresse de la chaine de commande INT{ADD(buf%,14)}=0 ! Ici, c'est vide ' appl_write(ap_id&,16,buf%) ! Envoi du message ' RETURN PROCEDURE appl_auftauen(child_id&) ! Gregor ' INT{buf%}=sm_m_special& ! 0 Message Identificateur INT{ADD(buf%,2)}=ap_id& ! 1 Application appelante INT{ADD(buf%,4)}=0 ! 2 Ici, c'est vide INT{ADD(buf%,6)}=0 ! 3 INT{ADD(buf%,8)}=CVI("MA") ! 4 INT{ADD(buf%,10)}=CVI("GX") ! 5 INT{ADD(buf%,12)}=smc_unfreeze& ! 6 INT{ADD(buf%,14)}=child_id& ! 7 ' appl_write(screnmgr&,16,buf%) ! Envoie par APPL_WRITE ' RETURN FUNCTION evnt_multi(flags&,cl&,ma&,st&,f1&,x1&,y1&,w1&,h1&,f2&,x2&,y2&,w2&,h2&,buf%,ct%,VAR mx&,my&,mk&,kbd&,key&,click&) ' Fonction AES Nø 25 (EVNT_MULTI) INT{ADD(GCONTRL,2)}=16 INT{ADD(GCONTRL,4)}=7 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=flags& INT{ADD(GINTIN,2)}=cl& INT{ADD(GINTIN,4)}=ma& INT{ADD(GINTIN,6)}=st& INT{ADD(GINTIN,8)}=f1& INT{ADD(GINTIN,10)}=x1& INT{ADD(GINTIN,12)}=y1& INT{ADD(GINTIN,14)}=w1& INT{ADD(GINTIN,16)}=h1& INT{ADD(GINTIN,18)}=f2& INT{ADD(GINTIN,20)}=x2& INT{ADD(GINTIN,22)}=y2& INT{ADD(GINTIN,24)}=w2& INT{ADD(GINTIN,26)}=h2& INT{ADD(GINTIN,28)}=WORD(ct%) INT{ADD(GINTIN,30)}=WORD(SWAP(ct%)) {ADDRIN}=buf% GEMSYS 25 mx&=INT{ADD(GINTOUT,2)} my&=INT{ADD(GINTOUT,4)} mk&=INT{ADD(GINTOUT,6)} kbd&=INT{ADD(GINTOUT,8)} key&=INT{ADD(GINTOUT,10)} click&=INT{ADD(GINTOUT,12)} RETURN INT{GINTOUT} ENDFUNC PROCEDURE menu_bar(me_btree%,me_bshow&) ! 30 INT{ADD(GCONTRL,2)}=1 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=0 INT{GINTIN}=me_bshow& {ADDRIN}=me_btree% GEMSYS 30 RETURN PROCEDURE menu_icheck(me_ctree%,me_citem&,me_ccheck&) ! 31 INT{ADD(GCONTRL,2)}=2 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=me_citem& INT{ADD(GINTIN,2)}=me_ccheck& {ADDRIN}=me_ctree% GEMSYS 31 RETURN PROCEDURE menu_ienable(me_ctree%,me_citem&,me_eenable&) ! 32 INT{ADD(GCONTRL,2)}=2 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=me_citem& INT{ADD(GINTIN,2)}=me_eenable& {ADDRIN}=me_ctree% GEMSYS 32 RETURN PROCEDURE menu_tnormal(me_ctree%,me_citem&,me_nnormal&) ! 33 INT{ADD(GCONTRL,2)}=2 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=me_citem& INT{ADD(GINTIN,2)}=me_nnormal& {ADDRIN}=me_ctree% GEMSYS 33 RETURN ' ! 42 PROCEDURE objc_draw(tree%,startob&,depth&,xclip&,yclip&,wclip&,hclip&,deb&) LOCAL axclip&,ayclip&,awclip&,ahclip& LOCAL ex&,ey&,ew&,eh&,i_& LOCAL s%,sl&,sh&,sp&,d%,dl&,dh&,dp& IF startob&=0 AND fond_img! AND fond%<>0 ' ************************* D‚finition du raster source s%=fond% ! L'image de fond (marbre ou autre) sl&=largeur_fond% ! Largeur sh&=hauteur_fond% ! Hauteur sp&=plan_systeme& ' ************************* D‚finition du raster destination d%=0 ! C'est le GEM qui s'occupe de tout ' ************************* Definition de la partie … d‚placer objc_draw_one(tree%,0,0,xclip&,yclip&,wclip&,hclip&) ex&=xclip& ey&=yclip& ew&=wclip& eh&=hclip& clip_raster(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&,ex&,ey&,ex&,ey&,ex&,ey&,ew&,eh&,3) IF deb&>-1 objc_draw_one(tree%,deb&,depth&,xclip&,yclip&,wclip&,hclip&) ELSE objc_draw_one(tree%,1,depth&,xclip&,yclip&,wclip&,hclip&) ENDIF ELSE objc_draw_one(tree%,startob&,depth&,xclip&,yclip&,wclip&,hclip&) ENDIF RETURN PROCEDURE objc_draw_one(tree%,startob&,depth&,xclip&,yclip&,wclip&,hclip&) graf_mouse(m_off&,0) INT{ADD(GCONTRL,2)}=6 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=startob& INT{ADD(GINTIN,2)}=depth& INT{ADD(GINTIN,4)}=xclip& INT{ADD(GINTIN,6)}=yclip& INT{ADD(GINTIN,8)}=wclip& INT{ADD(GINTIN,10)}=hclip& {ADDRIN}=tree% GEMSYS 42 graf_mouse(m_on&,0) RETURN FUNCTION objc_find(tree%,startob&,depth&,mx&,my&) ! 43 INT{ADD(GCONTRL,2)}=4 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=startob& INT{ADD(GINTIN,2)}=depth& INT{ADD(GINTIN,4)}=mx& INT{ADD(GINTIN,6)}=my& {ADDRIN}=tree% GEMSYS 43 RETURN INT{GINTOUT} ENDFUNC PROCEDURE objc_offset(tree%,obj&,VAR x&,y&) ! 44 INT{ADD(GCONTRL,2)}=1 INT{ADD(GCONTRL,4)}=3 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=obj& {ADDRIN}=tree% GEMSYS 44 x&=INT{ADD(GINTOUT,2)} y&=INT{ADD(GINTOUT,4)} RETURN PROCEDURE objc_edit(tree%,obj&,char&,idx&,kind&,VAR pos&) ! 46 INT{ADD(GCONTRL,2)}=4 INT{ADD(GCONTRL,4)}=2 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=obj& INT{ADD(GINTIN,2)}=char& INT{ADD(GINTIN,4)}=idx& INT{ADD(GINTIN,6)}=kind& {ADDRIN}=tree% GEMSYS 46 pos&=INT{ADD(GINTOUT,2)} RETURN PROCEDURE objc_change(adr%,ob&) ! 47 ob_state(adr%,ob&,aes_selected&,NOT BTST(OB_STATE(adr%,ob&),aes_selected&)) redraw_elem(adr%,ob&) RETURN FUNCTION form_do(fo_dotree%,fo_dostartob&) ! 50 INT{ADD(GCONTRL,2)}=1 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=fo_dostartob& {ADDRIN}=fo_dotree% GEMSYS 50 RETURN INT{GINTOUT} ENDFUNC PROCEDURE form_dial(flag&,tlx&,tly&,tlw&,tlh&,bigx&,bigy&,bigw&,bigh&) ! 51 INT{ADD(GCONTRL,2)}=9 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=flag& INT{ADD(GINTIN,2)}=tlx& INT{ADD(GINTIN,4)}=tly& INT{ADD(GINTIN,6)}=tlw& INT{ADD(GINTIN,8)}=tlh& INT{ADD(GINTIN,10)}=bigx& INT{ADD(GINTIN,12)}=bigy& INT{ADD(GINTIN,14)}=bigw& INT{ADD(GINTIN,16)}=bigh& GEMSYS 51 RETURN FUNCTION form_alert(defbttn&,string%) ! 52 INT{ADD(GCONTRL,2)}=1 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=defbttn& {ADDRIN}=string% GEMSYS 52 RETURN INT{GINTOUT} ENDFUNC FUNCTION form_error(fo_enum&) ! 53 INT{ADD(GCONTRL,2)}=1 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=fo_enum& GEMSYS 53 RETURN 0 ENDFUNC PROCEDURE form_center(tree%,VAR x&,y&,w&,h&) ! 54 INT{ADD(GCONTRL,2)}=0 INT{ADD(GCONTRL,4)}=5 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 {ADDRIN}=tree% GEMSYS 54 x&=INT{ADD(GINTOUT,2)} y&=INT{ADD(GINTOUT,4)} w&=INT{ADD(GINTOUT,6)} h&=INT{ADD(GINTOUT,8)} RETURN PROCEDURE graf_rubberbox(rx&,ry&,rminw&,rminh&,VAR ret&,ww&,hh&) ! 70 INT{ADD(GCONTRL,2)}=4 INT{ADD(GCONTRL,4)}=3 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=rx& INT{ADD(GINTIN,2)}=ry& INT{ADD(GINTIN,4)}=rminw& INT{ADD(GINTIN,6)}=rminh& GEMSYS 70 ret&=INT{GINTOUT} ww&=INT{ADD(GINTOUT,2)} hh&=INT{ADD(GINTOUT,4)} RETURN PROCEDURE graf_dragbox(dw&,dh&,dx&,dy&,dbx&,dby&,dbw&,dbh&,VAR nx&,ny&) ! 71 INT{ADD(GCONTRL,2)}=8 INT{ADD(GCONTRL,4)}=3 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=dw& INT{ADD(GINTIN,2)}=dh& INT{ADD(GINTIN,4)}=dx& INT{ADD(GINTIN,6)}=dy& INT{ADD(GINTIN,8)}=dbx& INT{ADD(GINTIN,10)}=dby& INT{ADD(GINTIN,12)}=dbw& INT{ADD(GINTIN,14)}=dbh& GEMSYS 71 nx&=INT{ADD(GINTOUT,2)} ny&=INT{ADD(GINTOUT,4)} RETURN PROCEDURE graf_slidebox(slptree%,slparent&,slobject&,slvh&,VAR pos&) ! 76 INT{ADD(GCONTRL,2)}=3 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=slparent& INT{ADD(GINTIN,2)}=slobject& INT{ADD(GINTIN,4)}=slvh& {ADDRIN}=slptree% GEMSYS 76 pos&=INT{GINTOUT} RETURN FUNCTION graf_handle(VAR wc&,hc&,cw&,ch&) ! 77 INT{ADD(GCONTRL,2)}=0 INT{ADD(GCONTRL,4)}=5 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 GEMSYS 77 wc&=INT{ADD(GINTOUT,2)} hc&=INT{ADD(GINTOUT,4)} cw&=INT{ADD(GINTOUT,6)} ch&=INT{ADD(GINTOUT,8)} RETURN INT{GINTOUT} ENDFUNC PROCEDURE graf_mouse(gr_monumber&,gr_mofaddr%) ! 78 LOCAL ok! ok!=TRUE IF ((gr_monumber&=m_on&) OR (gr_monumber&=m_off&)) AND magic! ok!=FALSE ENDIF IF ok! INT{ADD(GCONTRL,2)}=1 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=gr_monumber& {ADDRIN}=gr_mofaddr% GEMSYS 78 ENDIF RETURN PROCEDURE graf_mkstate(VAR mx&,my&,mk&,kbd&) ! 79 INT{ADD(GCONTRL,2)}=0 INT{ADD(GCONTRL,4)}=5 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 GEMSYS 79 mx&=INT{ADD(GINTOUT,2)} my&=INT{ADD(GINTOUT,4)} mk&=INT{ADD(GINTOUT,6)} kbd&=INT{ADD(GINTOUT,8)} RETURN FUNCTION wind_create(code&,wx&,wy&,ww&,wh&) ! 100 INT{ADD(GCONTRL,2)}=5 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=code& INT{ADD(GINTIN,2)}=wx& INT{ADD(GINTIN,4)}=wy& INT{ADD(GINTIN,6)}=ww& INT{ADD(GINTIN,8)}=wh& GEMSYS 100 RETURN INT{GINTOUT} ENDFUNC PROCEDURE wind_open(fen&,wx&,wy&,ww&,wh&) ! 101 graf_mouse(m_off&,0) INT{ADD(GCONTRL,2)}=5 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=fen& INT{ADD(GINTIN,2)}=wx& INT{ADD(GINTIN,4)}=wy& INT{ADD(GINTIN,6)}=ww& INT{ADD(GINTIN,8)}=wh& GEMSYS 101 graf_mouse(m_on&,0) RETURN PROCEDURE wind_close(fen&) ! 102 graf_mouse(m_off&,0) INT{ADD(GCONTRL,2)}=1 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=fen& GEMSYS 102 graf_mouse(m_on&,0) RETURN PROCEDURE wind_delete(fen&) ! 103 INT{ADD(GCONTRL,2)}=1 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=fen& GEMSYS 103 RETURN FUNCTION wind_get(fen&,code&,VAR wx&,wy&,ww&,wh&) ! 104 INT{ADD(GCONTRL,2)}=2 INT{ADD(GCONTRL,4)}=5 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=fen& INT{ADD(GINTIN,2)}=code& ' Merci … Fran‡ois LE COAT pour le truc de remplir les deux mots suivants ' avec 0 pour ‚viter les problŠmes sous MiNT INT{ADD(GINTOUT,6)}=0 INT{ADD(GINTOUT,8)}=0 GEMSYS 104 $S&,$S> SELECT code& CASE wf_workxywh&,wf_currxywh&,wf_prevxywh&,wf_fullxywh&,wf_firstxywh&,wf_nextxywh& wx&=INT{ADD(GINTOUT,2)} wy&=INT{ADD(GINTOUT,4)} ww&=INT{ADD(GINTOUT,6)} wh&=INT{ADD(GINTOUT,8)} CASE wf_hslide&,wf_vslide&,wf_top&,wf_hslsize&,wf_vslsize&,wf_winx& wx&=INT{ADD(GINTOUT,2)} ENDSELECT RETURN INT{GINTOUT} ENDFUNC PROCEDURE wind_set(fen&,code&,wx&,wy&,ww&,wh&) ! 105 IF mode_winx! ~WIND_GET(fen&,code&,wx&,wy&,ww&,wh&) ELSE INT{ADD(GCONTRL,2)}=6 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=fen& INT{ADD(GINTIN,2)}=code& INT{ADD(GINTIN,4)}=wx& INT{ADD(GINTIN,6)}=wy& INT{ADD(GINTIN,8)}=ww& INT{ADD(GINTIN,10)}=wh& GEMSYS 105 ENDIF RETURN FUNCTION wind_find(mx&,my&) ! 106 INT{ADD(GCONTRL,2)}=2 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=mx& INT{ADD(GINTIN,2)}=my& GEMSYS 106 RETURN INT{GINTOUT} ENDFUNC ' PROCEDURE aes_beg_mctrl ' IF cpt_aes_mctrl&=0 ' wind_update(beg_mctrl&) ' ENDIF ' INC cpt_aes_mctrl& RETURN PROCEDURE aes_end_mctrl ' DEC cpt_aes_mctrl& ' IF cpt_aes_mctrl&=0 ' wind_update(end_mctrl&) ' ENDIF RETURN PROCEDURE aes_beg_update ' IF cpt_aes_update&=0 ' wind_update(beg_update&) ' ENDIF ' INC cpt_aes_update& RETURN PROCEDURE aes_end_update ' DEC cpt_aes_update& ' IF cpt_aes_update&=0 ' wind_update(end_update&) ' ENDIF RETURN PROCEDURE wind_update(flag&) ! 107 IF mode_winx! ~WIND_UPDATE(flag&) ELSE INT{ADD(GCONTRL,2)}=1 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=flag& GEMSYS 107 ENDIF RETURN ' PROCEDURE wind_calc(flag&,wk&,wx&,wy&,ww&,wh&,VAR wx1&,wy1&,ww1&,wh1&) ! 108 INT{ADD(GCONTRL,2)}=6 INT{ADD(GCONTRL,4)}=5 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=flag& INT{ADD(GINTIN,2)}=wk& INT{ADD(GINTIN,4)}=wx& INT{ADD(GINTIN,6)}=wy& INT{ADD(GINTIN,8)}=ww& INT{ADD(GINTIN,10)}=wh& GEMSYS 108 wx1&=INT{ADD(GINTOUT,2)} wy1&=INT{ADD(GINTOUT,4)} ww1&=INT{ADD(GINTOUT,6)} wh1&=INT{ADD(GINTOUT,8)} RETURN FUNCTION rsrc_load(n%) ! 110 INT{ADD(GCONTRL,2)}=0 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=ap_id& {ADDRIN}=n% GEMSYS 110 RETURN INT{GINTOUT} ENDFUNC FUNCTION rsrc_free ! 111 INT{ADD(GCONTRL,2)}=0 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=ap_id& GEMSYS 111 RETURN INT{GINTOUT} ENDFUNC FUNCTION rsrc_gaddr(re_gtype&,re_gindex&,VAR re_gaddr%) ! 112 INT{ADD(GCONTRL,2)}=2 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=0 INT{ADD(GCONTRL,8)}=1 INT{GINTIN}=re_gtype& INT{ADD(GINTIN,2)}=re_gindex& GEMSYS 112 re_gaddr%={ADDROUT} RETURN INT{GINTOUT} ENDFUNC FUNCTION rsrc_saddr(re_gtype&,re_gindex&,VAR re_gaddr%) ! 113 INT{ADD(GCONTRL,2)}=2 INT{ADD(GCONTRL,4)}=1 INT{ADD(GCONTRL,6)}=1 INT{ADD(GCONTRL,8)}=0 INT{GINTIN}=re_gtype& INT{ADD(GINTIN,2)}=re_gindex& GEMSYS 113 re_gaddr%={ADDROUT} RETURN INT{GINTOUT} ENDFUNC FUNCTION rsrc_obfix(re_obj&,re_gaddr%) ! 114 INT{GINTIN}=re_obj& {ADDRIN}=re_gaddr% GEMSYS 114 RETURN {ADDROUT} ENDFUNC FUNCTION shel_read(sh_rpcmd%,sh_rptail%) ! 120 {ADDRIN}=sh_rpcmd% {ADD(ADDRIN,4)}=sh_rptail% GEMSYS 120 RETURN {ADDROUT} ENDFUNC FUNCTION shel_write(sh_wdoex&,sh_wisgr&,sh_wiscr&,sh_wpcmd%,sh_wptail%) ! 121 INT{GINTIN}=sh_wdoex& INT{ADD(GINTIN,2)}=sh_wisgr& INT{ADD(GINTIN,4)}=sh_wiscr& {ADDRIN}=sh_wpcmd% {ADD(ADDRIN,4)}=sh_wptail% GEMSYS 121 RETURN {ADDROUT} ENDFUNC FUNCTION shel_find(sh_fpbuff%) ! 124 {ADDRIN}=sh_fpbuff% GEMSYS 124 RETURN INT{GINTOUT} ENDFUNC ' ****************************************************************************** PROCEDURE ob_state(arb%,obj&,bit&,ind!) IF ind! OB_STATE(arb%,obj&)=BSET(OB_STATE(arb%,obj&),bit&) IF bit&=aes_selected& AND BTST(OB_STATE(arb%,obj&),wm_xcrossed&) ob_state(arb%,SUB(obj&,1),aes_crossed&,TRUE) ENDIF ELSE OB_STATE(arb%,obj&)=BCLR(OB_STATE(arb%,obj&),bit&) IF bit&=aes_selected& AND BTST(OB_STATE(arb%,obj&),wm_xcrossed&) ob_state(arb%,SUB(obj&,1),aes_crossed&,FALSE) ENDIF ENDIF RETURN PROCEDURE ob_flags(arb%,obj&,bit&,ind!) IF ind! OB_FLAGS(arb%,obj&)=BSET(OB_FLAGS(arb%,obj&),bit&) ELSE OB_FLAGS(arb%,obj&)=BCLR(OB_FLAGS(arb%,obj&),bit&) ENDIF RETURN ' ******************* Calcul manuel du clipping pour COPY RASTER *************** PROCEDURE clip_raster(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&,x11&,y11&,x21&,y21&,ex&,ey&,ew&,eh&,mod|) LOCAL x12&,y12&,x22&,y22& ' ********* Bien, alors la on r‚alise un CLIPPING … la main, parce-que les ' ********* COPY RASTER se moque totalement des CLIPPINGs VDIs. ' x11&,y11& (Position dans la zone source) ' x12&,y12& (Calculer dans cette proc‚dure) ' x21&,y21& (Position dans la zone destination) ' x22&,y22& (Calculer dans cette proc‚dure) ' ex&,ey&,ew&,eh& (Rectangle d‚limitant la zone copi‚e sur l'‚cran) ' 0,0,xmax&,ymax& (Rectangle zone d‚limitant l'‚cran) ' PremiŠrement, testont si l'ont est dansl'‚cran IF ex&0 AND PRED(ADD(ey&,eh&))>0 IF ex&<0 ADD x11&,-ex& CLR x21& SUB ew&,-ex& ENDIF IF PRED(ADD(ex&,ew&))>xmax& ! ATTENTION on sort de l'‚cran en X … droite x12&=ADD(x11&,SUB(xmax&,ex&)) ! X2 du raster source x22&=xmax& ! X2 du raster destination ELSE ! Ah ! l… tout va bien x12&=PRED(ADD(x11&,ew&)) ! X2 du raster source x22&=PRED(ADD(x21&,ew&)) ! X2 du raster destination ENDIF IF ey&<0 ADD y11&,-ey& CLR y21& SUB eh&,-ey& ENDIF IF PRED(ADD(ey&,eh&))>ymax& ! ATTENTION on sort de l'‚cran en Y en bas y12&=ADD(y11&,SUB(ymax&,ey&)) ! Y2 du raster source y22&=ymax& ! Y2 du raster destination ELSE ! Ah ! l… tout va bien y12&=PRED(ADD(y11&,eh&)) ! Y2 du raster source y22&=PRED(ADD(y21&,eh&)) ! Y2 du raster destination ENDIF $S|,$S> SELECT mod| CASE 0 TO 15 copy_raster_opaque(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&,x11&,y11&,x12&,y12&,x21&,y21&,x22&,y22&,mod|) CASE 255 copy_raster_transparent(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&,x11&,y11&,x12&,y12&,x21&,y21&,x22&,y22&) ENDSELECT ENDIF RETURN ' *************** Les calculs servant aux routines ci-dessus ******************* ' -------- Remplissage de la matrice 3 x 3 pour les calculs 3D PROCEDURE matrice_xyz(anga,angb,angc) LOCAL m% LOCAL cosa,sina LOCAL cosb,sinb LOCAL cosc,sinc cosa=COSQ(anga) sina=SINQ(anga) cosb=COSQ(angb) sinb=SINQ(angb) cosc=COSQ(angc) sinc=SINQ(angc) m%=ADD(matrice%,12) {m%}=(cosb*cosc)*1024 ! e0 {ADD(m%,4)}=(cosb*sinc)*1024 ! e3 {ADD(m%,8)}=(sinb)*1024 ! e6 {ADD(m%,12)}=(-sinb*sina*cosc-sinc*cosa)*1024 ! e1 {ADD(m%,16)}=(-sinb*sina*sinc+cosa*cosc)*1024 ! e4 {ADD(m%,20)}=(sina*cosb)*1024 ! e7 {ADD(m%,24)}=(-sinb*cosa*cosc+sina*sinc)*1024 ! e2 {ADD(m%,28)}=(-sinb*cosa*sinc-sina*cosc)*1024 ! e5 {ADD(m%,32)}=(cosa*cosb)*1024 ! e8 RETURN ' -------- Mise … l'echelle & rotation Z,Y et X & translation en mˆme temps PROCEDURE echel_rotat_trans(vp,hp,fp,tx%,ty%,tz%,nb_p%,tr%) LOCAL adr_poin%,fin_a% LOCAL xc%,yc%,zc% LOCAL tmp0%,tmp1% LOCAL crd%,cpd% LOCAL d%,m% {matrice%}=vp {ADD(matrice%,4)}=hp {ADD(matrice%,8)}=fp d%=1024 crd%=tr% cpd%=tr% DO m%=matrice% ' ------------------------ Lecture et mise … l'‚chelle d'un point ' Pour X xc%={crd%} ADD crd%,4 MUL xc%,{m%} ADD m%,4 DIV xc%,2 ' Pour Y yc%={crd%} ADD crd%,4 MUL yc%,{m%} ADD m%,4 DIV yc%,2 ' Pour Z zc%={crd%} ADD crd%,4 MUL zc%,{m%} ADD m%,4 DIV zc%,2 ' ----------------------- Rotation autour de X,Y et Z par matrice du point ' ----------------------- suivit de la translation ' Coordonn‚e X tmp0%=xc% MUL tmp0%,{m%} ADD m%,4 tmp1%=yc% MUL tmp1%,{m%} ADD m%,4 ADD tmp0%,tmp1% tmp1%=zc% MUL tmp1%,{m%} ADD m%,4 ADD tmp0%,tmp1% DIV tmp0%,d% ADD tmp0%,tx% {cpd%}=tmp0% ADD cpd%,4 ' Coordonn‚e Y tmp0%=xc% MUL tmp0%,{m%} ADD m%,4 tmp1%=yc% MUL tmp1%,{m%} ADD m%,4 ADD tmp0%,tmp1% tmp1%=zc% MUL tmp1%,{m%} ADD m%,4 ADD tmp0%,tmp1% DIV tmp0%,d% ADD tmp0%,ty% {cpd%}=tmp0% ADD cpd%,4 ' Coordonn‚e Z tmp0%=xc% MUL tmp0%,{m%} ADD m%,4 tmp1%=yc% MUL tmp1%,{m%} ADD m%,4 ADD tmp0%,tmp1% tmp1%=zc% MUL tmp1%,{m%} ADD m%,4 ADD tmp0%,tmp1% DIV tmp0%,d% ADD tmp0%,tz% {cpd%}=tmp0% ADD cpd%,4 ' DEC nb_p% LOOP WHILE nb_p%>0 RETURN ' ****************************************************************************** FUNCTION adresse_objet(nu&) RETURN ADD(univers%,MUL(nu&,taille_objet&)) ENDFUNC FUNCTION adresse_point(nu&) RETURN {ADD(objet%,SHL(nu&,2))} ENDFUNC FUNCTION adresse_edge(nu&) RETURN {ADD(edge%,SHL(nu&,2))} ENDFUNC FUNCTION adresse_face(adrob%) RETURN ADD(ADD(adrob%,2),MUL(SUCC(CARD{adrob%}),12)) ENDFUNC FUNCTION adresse_texture(nu&) RETURN ADD(texture%,MUL(nu&,taille_texture&)) ENDFUNC FUNCTION adresse_pigment(nu&) RETURN ADD(pigment%,MUL(nu&,taille_pigment&)) ENDFUNC FUNCTION adresse_normal(nu&) RETURN ADD(normal%,MUL(nu&,taille_normal&)) ENDFUNC FUNCTION adresse_finish(nu&) RETURN ADD(finish%,MUL(nu&,taille_finish&)) ENDFUNC FUNCTION adresse_interior(nu&) RETURN ADD(interior%,MUL(nu&,taille_interior&)) ENDFUNC FUNCTION adresse_liaison(nu&) RETURN ADD(liaison%,MUL(nu&,50)) ENDFUNC FUNCTION adresse_point_control(nu%) RETURN {ADD(pt_control%,SHL(nu%,2))} ENDFUNC FUNCTION adresse_point_extrude(nu%) RETURN {ADD(courbe_extrude%,SHL(nu%,2))} ENDFUNC FUNCTION adresse_liste_csg(nu%) RETURN {ADD(liste_csg%,SHL(nu%,2))} ENDFUNC FUNCTION adr_tpnfc(z_i%,nd&) RETURN ADD(z_i%,MUL(nd&,22)) ENDFUNC FUNCTION afficher_alerte(message_d_alerte%) RETURN @form_alert(1,message_d_alerte%) ENDFUNC FUNCTION lower(l%) LOCAL i&,l| IF LEN(CHAR{l%}) FOR i&=0 TO PRED(LEN(CHAR{l%})) l|=BYTE{ADD(l%,i&)} IF l|=>65 AND l|<=90 ADD l|,32 BYTE{ADD(l%,i&)}=l| ENDIF NEXT i& ENDIF RETURN l% ENDFUNC PROCEDURE vider_un_objet(nu&) LOCAL adr_int% ' membfill(@adresse_texture(nu&),taille_texture&,0) BYTE{ADD(@adresse_texture(nu&),2)}=24 membfill(@adresse_pigment(nu&),taille_pigment&,0) BYTE{ADD(@adresse_pigment(nu&),2)}=24 membfill(@adresse_normal(nu&),taille_normal&,0) BYTE{ADD(@adresse_normal(nu&),2)}=24 membfill(@adresse_finish(nu&),taille_finish&,0) membfill(@adresse_interior(nu&),taille_interior&,0) BYTE{ADD(@adresse_interior(nu&),48)}=BSET(BYTE{ADD(@adresse_interior(nu&),48)},5) BYTE{ADD(@adresse_interior(nu&),66)}=24 ' RETURN ' ****************************************************************************** ' **************************** Importation fichier 3DS ************************* ' ****************************************************************************** PROCEDURE importer_le_fichier LOCAL lar,hau,pro,milx,mily,milz LOCAL xj&,yj&,wj&,hj&,zone_mem% LOCAL lar_tot,hau_tot,pro_tot LOCAL taille_totale% ' CHAR{masque%}="3ds"+CHR$(0) IF NOT dial! definition_fichier(adr_parametres%,che3d2&,nom_divers%,FALSE,TRUE,OB_SPEC(adr_divers%,lin32&)) ELSE definition_fichier(adr_parametres%,che3d2&,nom_divers%,FALSE,FALSE,OB_SPEC(adr_divers%,lin32&)) ENDIF IF CHAR{nom_divers%}<>"" CHAR{mem_che%}=CHAR{disque%}+CHAR{path%}+CHAR{nom_divers%}+CHR$(0) IF @s_exist(mem_che%) CHAR{{OB_SPEC(adr_parametres%,che3d2&)}}=CHAR{disque%}+CHAR{path%}+"*."+CHAR{masque%} ' CHAR{mem_che%}=CHAR{eb_temp%}+"\impor3ds.cfg"+CHR$(0) IF @s_exist(mem_che%) lire_impor3ds.cfg(so_lu&) ELSE CLR so_lu& ENDIF ' CHAR{{OB_SPEC(adr_3d2%,titimp3d&)}}=CHAR{masque%} CHAR{{OB_SPEC(adr_3d2%,nom3d2&)}}="ANALYSE" ob_flags(adr_3d2%,chapt3d2&,aes_hidetree&,TRUE) ob_flags(adr_3d2%,chafa3d2&,aes_hidetree&,TRUE) ob_flags(adr_3d2%,simpl3d2&,aes_hidetree&,TRUE) form_center(adr_3d2%,xj&,yj&,wj&,hj&) objc_draw(adr_3d2%,0,12,xj&,yj&,wj&,hj&,-1) ' IF dial! lire_coef_tot.mvt(coef,milx_tot,mily_tot,milz_tot) CHAR{mem_che%}=CHAR{eb_temp%}+"\coef_tot.mvt"+CHR$(0) ~GEMDOS(&H41,L:mem_che%) ELSE CHAR{mem_nom%}="[2][Voulez-vous les|sources de lumiŠre|" CHAR{mem_nom%}=CHAR{mem_nom%}+"et la cam‚ra si il|y en a ?]" CHAR{mem_nom%}=CHAR{mem_nom%}+"[ Oui | Non ]"+CHR$(0) so_lu&=@form_alert(so_lu&,mem_nom%) sauver_impor3ds.cfg(so_lu&) ENDIF ' taille_totale%=ADD(ADD(ADD(512,512),512),SHL(limite_des_objets&,2)) ' zone_mem%=@prendre(taille_totale%,TRUE,3) ' nom_temp%=zone_mem% buf%=ADD(nom_temp%,512) mem%=ADD(buf%,512) memoire_taille%=ADD(mem%,512) ' CHAR{mem_che%}=CHAR{disque%}+CHAR{path%}+CHAR{nom_divers%}+CHR$(0) CLR nbobjects& PRINT CHAR{mem_che%} attend_touche OPEN "i",#1,CHAR{mem_che%} IF NOT @import3ds CLOSE #1 IF ADD(nombre_d_objets&,nbobjects&)>limite_des_objets& ~@afficher_alerte(adr_depasse%) CHAR{mem_che%}="[1][ "+STR$(nbobjects&)+" objets trouv‚s |" CHAR{mem_che%}=CHAR{mem_che%}+" dans le fichier | " CHAR{mem_che%}=CHAR{mem_che%}+STR$(nombre_d_objets&)+" objects find |" CHAR{mem_che%}=CHAR{mem_che%}+" in file ][ Ok ]"+CHR$(0) ~@afficher_alerte(mem_che%) ENDIF ecrire_le_fichier_de_transfert_vide ELSE CLOSE #1 IF NOT dial! IF ADD(nombre_d_objets&,nbobjects&)>limite_des_objets& ~@afficher_alerte(adr_depasse%) CHAR{mem_che%}="[1][ "+STR$(nbobjects&)+" objets trouv‚s |" CHAR{mem_che%}=CHAR{mem_che%}+" dans le fichier | " CHAR{mem_che%}=CHAR{mem_che%}+STR$(nombre_d_objets&)+" objects find |" CHAR{mem_che%}=CHAR{mem_che%}+" in file ][ Ok ]"+CHR$(0) ~@afficher_alerte(mem_che%) ecrire_le_fichier_de_transfert_vide ELSE ' lar_tot=(scene_maxx-scene_minx) hau_tot=(scene_maxy-scene_miny) pro_tot=(scene_maxz-scene_minz) ' milx_tot=scene_minx+(lar_tot/2) mily_tot=scene_miny+(hau_tot/2) milz_tot=scene_minz+(pro_tot/2) ' coef=(lar_tot+hau_tot+pro_tot)/3 IF (coef>250) AND (coef<500) coef=1 ELSE coef=500/coef ENDIF sauver_coef_tot.mvt(coef,milx_tot,mily_tot,milz_tot) ' ecrire_le_fichier_de_transfert_retour(-1,nbobjects&,memoire_taille%) ENDIF ENDIF ENDIF libere(*zone_mem%) ELSE ecrire_le_fichier_de_transfert_vide ENDIF ELSE ecrire_le_fichier_de_transfert_vide ENDIF RETURN ' ------------------------------------------------------------- Niveau --------- FUNCTION import3ds ! 0 LOCAL st0%,en0%,le0%,ta0% start_chunk(st0%,en0%,le0%,ta0%) IF le0%>LOF(#1) CHAR{mem_che%}="[1][ Fichier endommag‚.|Damage file. ][ D‚sol‚ | Sorry ]"+CHR$(0) ~@afficher_alerte(mem_che%) RETURN FALSE ELSE IF ta0%=m3dmagic% IF NOT @lire_3ds(en0%) RETURN FALSE ENDIF ELSE IF ta0%=editeur_3d% IF NOT @lire_editeur_3d(en0%) RETURN FALSE ENDIF ELSE RETURN FALSE ENDIF ENDIF RETURN TRUE ENDFUNC ' FUNCTION lire_3ds(fin_lire_3ds%) ! 1 LOCAL st1%,en1%,le1%,ta1% DO start_chunk(st1%,en1%,le1%,ta1%) IF en1%<=fin_lire_3ds% SELECT ta1% CASE editeur_3d% IF NOT @lire_editeur_3d(en1%) RETURN FALSE ENDIF CASE edit_version% ~@read_long_i ENDSELECT ENDIF fin_chunk(en1%) LOOP WHILE en1%8 CHAR{{OB_SPEC(adr_3d2%,nom3d2&)}}=LEFT$(CHAR{nom_temp%},8) ELSE CHAR{{OB_SPEC(adr_3d2%,nom3d2&)}}=CHAR{nom_temp%} ENDIF redraw_elem(adr_3d2%,nom3d2&) ' DO start_chunk(st3%,en3%,le3%,ta3%) IF en3%<=fin_lire_objet_facette% SELECT ta3% CASE definition_objet% IF NOT @lire_definition_objet(en3%) RETURN FALSE ENDIF CASE une_source% IF NOT @lire_une_source(en3%) RETURN FALSE ENDIF CASE une_camera% IF NOT @lire_une_camera RETURN FALSE ENDIF ENDSELECT ENDIF fin_chunk(en3%) LOOP WHILE en3%0 CHAR{{OB_SPEC(adr_3d2%,p3d2nb&)}}=STR$(pointnb%,5) redraw_elem(adr_3d2%,p3d2nb&) IF dial! adr_poi%=@adresse_point(ADD(primitive&,nbobjects&)) CARD{adr_poi%}=PRED(pointnb%) ad%=ADD(adr_poi%,2) CLR i% DO read_point_i(ad%) ! Coordonn‚es du point ADD ad%,12 INC i% LOOP WHILE i%0 AND pointnb%>0 IF (facepos%+facenb%*8)>fin_lire_definition% RETURN FALSE ENDIF CHAR{{OB_SPEC(adr_3d2%,f3d2nb&)}}=STR$(facenb%,5) redraw_elem(adr_3d2%,f3d2nb&) IF dial! adr_poi%=@adresse_point(ADD(primitive&,nbobjects&)) adr_fac%=@adresse_face(adr_poi%) CARD{adr_fac%}=PRED(facenb%) ad%=ADD(adr_fac%,2) CLR i% DO CARD{ad%}=@read_word_i ! Pt1 CARD{ADD(ad%,4)}=@read_word_i ! Pt3 CARD{ADD(ad%,2)}=@read_word_i ! Pt2 ~@read_word_i ADD ad%,6 INC i% LOOP WHILE i%limite_des_objets& RETURN FALSE ENDIF IF facenb% IF NOT dial! taille_p%=ADD(MUL(pointnb%,12),2) taille_f%=ADD(MUL(facenb%,6),2) {ADD(memoire_taille%,SHL(nbobjects&,2))}=ADD(taille_p%,taille_f%) ELSE ' ---------------------------------------------------------------------- adr_poi%=@adresse_point(ADD(primitive&,nbobjects&)) repositionne_objet(adr_poi%,pointnb%,lar,hau,pro,milx,mily,milz) univ%=@adresse_objet(ADD(nombre_d_objets&,nbobjects&)) SINGLE{ADD(univ%,2)}=ROUND((milx-milx_tot)*coef,3) SINGLE{ADD(univ%,6)}=ROUND((mily-mily_tot)*coef,3) SINGLE{ADD(univ%,10)}=ROUND((milz-milz_tot)*coef,3) SINGLE{ADD(univ%,14)}=ROUND(lar*coef,3) SINGLE{ADD(univ%,18)}=ROUND(hau*coef,3) SINGLE{ADD(univ%,22)}=ROUND(pro*coef,3) ' INT{univ%}=ADD(primitive&,nbobjects&) ' vider_un_objet(nombre_d_objets&) ' BYTE{ADD(univ%,offset_drapeau0&)}=BSET(BYTE{ADD(univ%,offset_drapeau0&)},bit_facette|) INT{ADD(univ%,offset_relation_csg&)}=-1 IF NOT nom_trouve! INT{ADD(univ%,offset_couleur&)}=BYTE{ADD(ADD(nom_calque%,MUL(calque_actif|,36)),34)} ENDIF ' IF LEN(CHAR{nom_temp%})>21 CHAR{ADD(univ%,offset_nom_objet&)}=LEFT$(CHAR{nom_temp%},21) ELSE CHAR{ADD(univ%,offset_nom_objet&)}=CHAR{nom_temp%} ENDIF ' ENDIF INC nbobjects& ENDIF RETURN TRUE ENDFUNC FUNCTION lire_une_source(fin_lire_une_source%) ! 4 LOCAL st4%,en4%,le4%,ta4% LOCAL adr_sr% ' adr_sr%=-1 ' IF dial! AND so_lu&=1 IF nbl&21 CHAR{ADD(adr_sr%,62)}=LEFT$(CHAR{nom_temp%},21) ELSE CHAR{ADD(adr_sr%,62)}=CHAR{nom_temp%} ENDIF SINGLE{ADD(adr_sr%,8)}=(@read_float_i-milx_tot)*coef SINGLE{ADD(adr_sr%,16)}=(@read_float_i-milz_tot)*coef SINGLE{ADD(adr_sr%,12)}=(@read_float_i-mily_tot)*coef ELSE read_point_i(mem%) ! Position de la lampe ENDIF ELSE read_point_i(mem%) ! Position de la lampe ENDIF ' DO start_chunk(st4%,en4%,le4%,ta4%) IF en4%<=fin_lire_une_source% SELECT ta4% CASE color_f% IF adr_sr%=-1 IF NOT @lire_color_f(-1) RETURN FALSE ENDIF ELSE IF NOT @lire_color_f(ADD(adr_sr%,4)) RETURN FALSE ENDIF CARD{ADD(adr_sr%,2)}=0 ENDIF CASE color_24% IF adr_sr%=-1 IF NOT @lire_color_24(-1) RETURN FALSE ENDIF ELSE IF NOT @lire_color_24(ADD(adr_sr%,4)) RETURN FALSE ENDIF CARD{ADD(adr_sr%,2)}=0 ENDIF CASE dl_off% IF adr_sr%>0 BYTE{adr_sr%}=0 ENDIF CASE dl_spotlight% IF adr_sr%=-1 IF NOT @lire_dl_spotlight(adr_sr%) RETURN FALSE ENDIF ELSE IF NOT @lire_dl_spotlight(-1) RETURN FALSE ENDIF ENDIF ENDSELECT ENDIF fin_chunk(en4%) LOOP WHILE en4%-1 AND so_lu&=1 SINGLE{ADD(adr_sr%,20)}=(@read_float_i*100-milx_tot)*coef ! \ SINGLE{ADD(adr_sr%,28)}=(@read_float_i*100-milz_tot)*coef ! > Pt de vis‚e SINGLE{ADD(adr_sr%,24)}=(@read_float_i*100-mily_tot)*coef ! / INT{ADD(adr_sr%,48)}=ROUND(@read_float_i*360) ! HotSpot INT{ADD(adr_sr%,50)}=ROUND(@read_float_i*360) ! FallOff BYTE{ADD(adr_sr%,1)}=BTST(BYTE{ADD(adr_sr%,1)},bit_spot|) ELSE read_point_i(mem%) ! Point de vis‚e du spot ~@read_float_i ! HotSpot ~@read_float_i ! FallOff ENDIF RETURN TRUE ENDFUNC FUNCTION lire_color_f(ad%) IF ad%<>-1 BYTE{ad%}=ROUND(@read_float_i*255) ! Rouge BYTE{ADD(ad%,1)}=ROUND(@read_float_i*255) ! Vert BYTE{ADD(ad%,2)}=ROUND(@read_float_i*255) ! Bleu ELSE ~@read_float_i ! Rouge ~@read_float_i ! Vert ~@read_float_i ! Bleu ENDIF ' ! Alpha=0.0 RETURN TRUE ENDFUNC FUNCTION lire_color_24(ad%) LOCAL col&,ro|,ve|,bl|,univ% IF ad%<>-1 BYTE{ad%}=@read_byte ! Rouge BYTE{ADD(ad%,1)}=@read_byte ! Vert BYTE{ADD(ad%,2)}=@read_byte ! Bleu ELSE ~@read_byte ! Rouge ~@read_byte ! Vert ~@read_byte ! Bleu ENDIF RETURN TRUE ENDFUNC FUNCTION lire_int_pourcentage RETURN @read_word_i ENDFUNC FUNCTION lire_float_pourcentage RETURN @read_float_i ENDFUNC ' ------------------------------------------------------------------------------ PROCEDURE start_chunk(VAR start%,end%,length%,tag%) start%=LOC(#1) tag%=@read_word_i length%=@read_long_i end%=ADD(start%,length%) RETURN PROCEDURE fin_chunk(end%) SEEK #1,end% RETURN ' FUNCTION nom_au_bon_format$(buf_nam%) LOCAL bn%,car| ' bn%=buf_nam% DO car|=BYTE{bn%} EXIT IF car|=0 $S|,$S< SELECT car| CASE 65 TO 90,48 TO 57 ' de 65 … 90, il n'y a rien … faire, se sont des majuscules accept‚es ' de 40 … 57, idem, se sont les chiffres. CASE 97 TO 122 ' Tiens, des minuscule...Changons les en MAJUSCULE SUB car|,32 CASE 0 TO 47,58 TO 64,91 TO 96,123 TO 128 ' Tout les caractŠres que P.O.V. ne supporte pas ou qui, franchement ne ' sont pas du plus bel effet dans un nom, mettons un '_' … la place. car|=95 CASE 129,150,151,152,154,163 ' L…, que des 'U' accentu‚s (dans l'ASCII ATARI), donc un simple 'U' car|=58 CASE 128,135,155 ' La, que des 'C' sp‚ciaux, donc un simple 'C' car|=67 CASE 130,136,137,138,144 ' La, que des 'E' sp‚ciaux, donc un simple 'E' car|=69 CASE 131,132,133,134,142,143,145,146,160,166,176,182,183 ' La, que des 'A' sp‚ciaux, donc un simple 'A' car|=65 CASE 139,140,141,161,173 ' La, que des 'I' sp‚ciaux, donc un simple 'I' car|=73 CASE 147,148,149,153,162,167,177,184 ' La, que des 'O' sp‚ciaux, donc un simple 'O' car|=79 CASE 152 ' La, un '˜', donc un simple 'Y' car|=89 DEFAULT ' Sinon, et bien, quend on ne sait pas on s'abstient. Alors, on met un '_' car|=95 ENDSELECT BYTE{bn%}=car| INC bn% LOOP ' RETURN CHAR{buf_nam%} ENDFUNC ' ---------------------- Conversion INTEL -> MOTOROLA -------------------------- PROCEDURE lire_une_ligne(b%) LOCAL lig% lig%=b% DO BGET #1,lig%,1 EXIT IF BYTE{lig%}=0 INC lig% LOOP RETURN PROCEDURE read_point_i(zo%) SINGLE{zo%}=@read_float_i*100 SINGLE{ADD(zo%,8)}=@read_float_i*100 SINGLE{ADD(zo%,4)}=@read_float_i*100 RETURN FUNCTION read_byte BGET #1,buf%,1 RETURN BYTE{buf%} ENDFUNC FUNCTION read_word_i LOCAL octet| BGET #1,buf%,2 octet|=BYTE{buf%} BMOVE SUCC(buf%),buf%,1 BYTE{SUCC(buf%)}=octet| RETURN CARD{buf%} ENDFUNC FUNCTION read_long_i LOCAL mot% BGET #1,buf%,4 intel_w(buf%) intel_w(ADD(buf%,2)) mot%=CARD{buf%} BMOVE ADD(buf%,2),buf%,2 CARD{ADD(buf%,2)}=mot% RETURN {buf%} ENDFUNC FUNCTION read_float_i LOCAL mot% BGET #1,buf%,4 intel_w(buf%) intel_w(ADD(buf%,2)) mot%=CARD{buf%} BMOVE ADD(buf%,2),buf%,2 CARD{ADD(buf%,2)}=mot% RETURN SINGLE{buf%} ENDFUNC PROCEDURE intel_w(buw%) LOCAL octet| octet|=BYTE{buw%} BMOVE SUCC(buw%),buw%,1 BYTE{SUCC(buw%)}=octet| RETURN ' ------------------------------------------------------------------------------ PROCEDURE repositionne_objet(ad%,nbp%,VAR lar,hau,pro,milx,mily,milz) LOCAL x,y,z,i%,u% LOCAL minx,miny,minz LOCAL maxx,maxy,maxz LOCAL fin_i% minx=3.599386269725E+308 miny=3.599386269725E+308 minz=3.599386269725E+308 maxx=-3.599386269725E+308 maxy=-3.599386269725E+308 maxz=-3.599386269725E+308 fin_i%=ADD(ADD(ad%,2),MUL(nbp%,12)) i%=ADD(ad%,2) DO x=SINGLE{i%} y=SINGLE{ADD(i%,4)} z=SINGLE{ADD(i%,8)} minx=MIN(minx,x) miny=MIN(miny,y) minz=MIN(minz,z) maxx=MAX(maxx,x) maxy=MAX(maxy,y) maxz=MAX(maxz,z) ADD i%,12 LOOP WHILE i%1 {i%}=((x-milx)/(lar/2))*1024 ELSE {i%}=(x-milx)*1024 ENDIF IF hau>1 {ADD(i%,4)}=((y-mily)/(hau/2))*1024 ELSE {ADD(i%,4)}=(y-mily)*1024 ENDIF IF pro>1 {ADD(i%,8)}=((z-milz)/(pro/2))*1024 ELSE {ADD(i%,8)}=(z-milz)*1024 ENDIF ADD i%,12 LOOP WHILE i%1 $S$,$S> SELECT VAL(LEFT$(CHAR{ligne%},3)) CASE 0 enleve_code(ligne%) so_lu&=VAL(CHAR{ligne%}) ENDSELECT ENDIF EXIT IF termine! LOOP ENDIF CLOSE #1 ' libere(*ligne%) ' RETURN PROCEDURE sauver_coef_tot.mvt(coef,milx_tot,mily_tot,milz_tot) ' OPEN "o",#1,CHAR{eb_temp%}+"\coef_tot.mvt" PRINT #1,"000 ";coef PRINT #1,"001 ";milx_tot PRINT #1,"002 ";mily_tot PRINT #1,"003 ";milz_tot PRINT #1,"EOF" CLOSE #1 ' RETURN PROCEDURE lire_coef_tot.mvt(VAR coef,milx_tot,mily_tot,milz_tot) LOCAL termine!,ligne% ' ligne%=@prendre(1024,TRUE,3) ' OPEN "i",#1,CHAR{eb_temp%}+"\coef_tot.mvt" IF LOF(#1) DO membfill(ligne%,1024,0) termine!=@lire_une_ligne(ligne%) EXIT IF LEFT$(CHAR{ligne%},3)="EOF" IF LEN(CHAR{ligne%})>1 $S$,$S> SELECT VAL(LEFT$(CHAR{ligne%},3)) CASE 0 enleve_code(ligne%) coef=VAL(CHAR{ligne%}) CASE 1 enleve_code(ligne%) milx_tot=VAL(CHAR{ligne%}) CASE 2 enleve_code(ligne%) mily_tot=VAL(CHAR{ligne%}) CASE 3 enleve_code(ligne%) milz_tot=VAL(CHAR{ligne%}) ENDSELECT ENDIF EXIT IF termine! LOOP ENDIF CLOSE #1 ' libere(*ligne%) ' RETURN PROCEDURE attend_touche LOCAL a$ ' DO a$=INKEY$ EXIT IF a$<>"" LOOP ' RETURN