FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» Planétarium virtuel.
par Pedro Alvarez Hier à 16:57

» Roues dentées
par jean_debord Hier à 10:40

» Attention arnaque !
par mindstorm Jeu 19 Juil 2018 - 19:18

» Qui fait quoi ?
par silverman Mer 18 Juil 2018 - 15:21

» ITEM_SELECT N,L pour synedit
par silverman Mer 18 Juil 2018 - 15:20

» Boussole
par jean_debord Mer 18 Juil 2018 - 11:06

» Roue à n faces
par Marc Dim 15 Juil 2018 - 22:16

» Exemple d'une nouvelle version d'un GRID
par Jean Claude Ven 13 Juil 2018 - 10:32

» Une simple question
par Oscaribout Sam 7 Juil 2018 - 23:20

» BUG sur l'objet TAB
par Jack Sam 7 Juil 2018 - 21:12

» Monopoly moderne
par jjn4 Sam 7 Juil 2018 - 15:06

» Récapitulatif ludothèque panoramic jjn4
par jjn4 Ven 6 Juil 2018 - 17:41

» Lignes ondulées
par JL35 Ven 6 Juil 2018 - 17:39

» bug off_activate 0 : sans d'effet
par silverman Ven 6 Juil 2018 - 13:02

» Position des objets d'un conteneur dans FBPano et Panoramic
par Navigateur Ven 6 Juil 2018 - 12:59

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Juillet 2018
LunMarMerJeuVenSamDim
      1
2345678
9101112131415
16171819202122
23242526272829
3031     
CalendrierCalendrier

Partagez | 
 

 Boussole

Aller en bas 
AuteurMessage
Marc

avatar

Nombre de messages : 803
Age : 57
Localisation : TOURS
Date d'inscription : 17/03/2014

MessageSujet: Boussole   Ven 13 Juil 2018 - 23:59

Bonjour à tous !

Pour le plaisir de programmer : voici une boussole un peu particulière, elle indique la position de la souris.
Elle est réalisée avec un mélange de 2D et 3D.
Le moteur 3D de Panoramic permet une très bonne fluidité et rapidité du déplacement de l'aiguille.

Code:
' ------------------------------------------------------------------------------
'  PANORAMIC Compass / Boussole
'  Marc - July 2018 - Panoramic v0.9.28
'  http://panoramic-language.pagesperso-orange.fr/French/index.html
'  http://panoramic.top-forum.net
' ------------------------------------------------------------------------------
' Main
    Init()
    Instructions()
    Needle()
    Background()
    ON_MOUSE_MOVE 1,Move1
    ON_MOUSE_MOVE 2,Move2
END
' ------------------------------------------------------------------------------
SUB Init()
    HEIGHT 0,540 + HEIGHT(0)-HEIGHT_CLIENT(0)
    WIDTH 0,500 + WIDTH(0)-WIDTH_CLIENT(0)
    LEFT 0,(screen_x-WIDTH(0))/2
    TOP 0,(screen_y-HEIGHT(0))/2
    COLOR 0,0,0,0
    LABEL Move1, Move2, Quit
    DIM x,y,z
    DEGREES
    ON_CLOSE 0, Quit
END_SUB
' ------------------------------------------------------------------------------
SUB Background()
    DIM_LOCAL i%,x,y
    PICTURE 1
    WIDTH 1,500
    HEIGHT 1,500
    COLOR 1,0,0,0
    PRINT_TARGET_IS 1
    FONT_NAME 1,"Arial"
    FONT_BOLD 1
    FONT_SIZE 1,"12"
    FONT_COLOR 1,0,0,0
    2D_TARGET_IS 1
    2D_PEN_COLOR 0,0,0
    2D_FILL_COLOR 255,255,255
    2D_CIRCLE 250,250,200
    FOR i% = 0 TO 360 STEP 10
         x= 185*COS(i%)+250
         y= 185*SIN(i%)+250
         2D_LINE 250,250,x,y
    NEXT i%
    FOR i% = 0 TO 360 STEP 45
         x= 195*COS(i%)+250
         y= 195*SIN(i%)+250
         2D_LINE 250,250,x,y
    NEXT i%
    2D_FILL_COLOR 0,0,0
    2D_POLY_FROM 250,75
    2D_POLY_TO 425,250
    2D_POLY_TO 250,425
    2D_POLY_TO 75,250
    2D_POLY_TO 250,75
    2D_FLOOD 247,87,0,0,0
    2D_FLOOD 413,253,0,0,0
    2D_FLOOD 246,412,0,0,0
    2D_FLOOD 87,247,0,0,0
    2D_CIRCLE 250,250,160
    2D_FILL_COLOR 255,255,255
    PRINT_LOCATE 245,52
    PRINT "N"
    PRINT_LOCATE 245,430
    PRINT "S"
    PRINT_LOCATE 433,242
    PRINT "E"
    PRINT_LOCATE 55,242
    PRINT "W"
    2D_FILL_COLOR 0,0,0
    FONT_COLOR 1,255,255,255
END_SUB
' ------------------------------------------------------------------------------
SUB Needle()
    PICTURE 3
    WIDTH 3,240
    HEIGHT 3,240
    TOP 3,130
    LEFT 3,130
    COLOR 3,0,0,0
    2D_TARGET_IS 3
    2D_PEN_COLOR 255,255,255
    ' Needle Tip
    2D_LINE 0,120,20,110
    2D_LINE 0,120,20,130
    2D_LINE 19,110,19,130
    2D_FILL_COLOR 255,255,255
    2D_FLOOD 6,120,255,255,255
    ' Needle Body
    2D_LINE 0,120,240,120
    2D_LINE 6,119,240,119
    2D_LINE 6,121,240,121
    ' Needle Center
    2D_CIRCLE 120,120,6
    2D_PEN_COLOR 0,0,0
    2D_CIRCLE 120,120,2
    ' Needle End
    2D_PEN_COLOR 255,255,255
    2D_CIRCLE 235,120,13
    2D_FILL_COLOR 0,0,0
    2D_CIRCLE 239,120,12
    IMAGE 4
    2D_IMAGE_COPY 4,0,0,240,240
    SCENE3D 2
    WIDTH 2,240
    HEIGHT 2,240
    LEFT 2,130
    TOP 2,130
    COLOR 2,0,0,0
    3D_PLANE 5
    3D_V_TILE 5,1
    3D_U_TILE 5,1
    CAM_POSITION 0,0,15.8
    3D_IMAGE_TEXTURE 5,4
END_SUB
' ------------------------------------------------------------------------------
SUB Instructions()
    PICTURE 50
    HEIGHT 50,40
    WIDTH 50,500
    TOP 50,500
    COLOR 50,0,0,0
    2D_TARGET_IS 50
    2D_FILL_COLOR 0,0,0
    PRINT_TARGET_IS 50
    FONT_NAME 50,"Times New Roman"
    FONT_SIZE 50,18
    FONT_ITALIC 50
    FONT_COLOR 50,255,255,255
    PRINT_LOCATE 55,8
    PRINT "Move the mouse   /   Bougez la souris"
END_SUB                        
' ------------------------------------------------------------------------------
Move1:
    x = MOUSE_X_POSITION(1)-250
    y = MOUSE_Y_POSITION(1)-250
    Action()
RETURN
' ------------------------------------------------------------------------------
Move2:
    x = MOUSE_X_POSITION(2)-120
    y = MOUSE_Y_POSITION(2)-120
    Action()
RETURN
' ------------------------------------------------------------------------------
SUB Action()
    IF x=0 AND y=0
    ELSE
        z = (ACOS(y/SQR(x*x+y*y))-180)*-1
    END_IF
    IF x < 0
        z=360-z
    END_IF
    3D_Z_ROTATE 5,(270-z)
    PRINT_LOCATE 237,383
    IF z > 9.99 THEN PRINT_LOCATE 233,383
    IF z > 99.99 THEN PRINT_LOCATE 229,383
    PRINT "  "+STR$(INT(z+0.5))+"°"+"     "
END_SUB
' ------------------------------------------------------------------------------
Quit:
    TERMINATE
RETURN

Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5527
Age : 64
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Boussole   Sam 14 Juil 2018 - 10:42

Bravo Marc,

Un beau code bien propre ! Je garde sous le coude, ça peut servir. Very Happy

A+
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Marc

avatar

Nombre de messages : 803
Age : 57
Localisation : TOURS
Date d'inscription : 17/03/2014

MessageSujet: Re: Boussole   Lun 16 Juil 2018 - 14:03

Salut Jean-Claude !

Merci pour ton retour.

Il est vrai que c'est encore un "source gadget" qui ne sert à rien... Juste pour le plaisir de programmer.

Bonne journée estivale !
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Ouf_ca_passe

avatar

Nombre de messages : 236
Age : 69
Localisation : Villeneuve d'Ascq (59-Dpt du NORD) France
Date d'inscription : 21/12/2015

MessageSujet: Re: Boussole   Mer 18 Juil 2018 - 9:49

Bonjour les Panoramicien(ne)s et FBPanistes

Marc a écrit a écrit:

Il est vrai que c'est encore un "source gadget" qui ne sert à rien... Juste pour le plaisir de programmer.

Je ne suis pas d'accord avec ce que Marc a écrit.
Tout partage sur le forum (avec le code) mérite respect et considération.

Si Marc ou qq'un d'autre veut se lancer dans des simulations statiques ou dynamiques (avec animation), il y a des idées à prendre chez Phet Colorado ou QuCS (labo de physique) ou d'autres.

Cordialement
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
jean_debord

avatar

Nombre de messages : 817
Age : 63
Localisation : Limoges
Date d'inscription : 21/09/2008

MessageSujet: Re: Boussole   Mer 18 Juil 2018 - 11:06

Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://www.unilim.fr/pages_perso/jean.debord/index.htm
Contenu sponsorisé




MessageSujet: Re: Boussole   

Revenir en haut Aller en bas
 
Boussole
Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» Est-ce que le Edge800 possède une boussole ? NON [résolu]
» Etrex 30 compas
» oregon 450T affichage boussole en mode carte
» Boussole
» pick-up (Ford Ranger Double Cabine XLT Limited 2.5 TDCi)

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Vos sources, vos utilitaires à partager-
Sauter vers: