Modulation, souplesse et champignons

[Ollivier]

Salut,

Bon... Le titre n'est pas clair. Le résultat non plus! N'essayez pas de comprendre ce qui me motive. Comme d'habitude, je m'illumine d'un rien absurde. J'ai juste créé ce post pour poster au fur et à mesure ma manière de voir la programmation.

[Ollivier]

Procédure : La procédure est un lieu saint où s'effectuent des rites étranges. Elle possède
une façade magnifique (la première ligne) avec des bas-reliefs qui subliment l'argumentaire
par sa conceptuelle cloisonnée. La visite se finit toujours par un «EndProcedure», comme
un cul-de-sac illusoire, une fausse fin.

Code : Tout sélectionner

Procedure Sanctuaire()
Debug "Lieu saint où s'effectuent des instructions bizarres"
EndProcedure

Admirez cette procédure nommée «Sanctuaire».

Si le lieu saint se trouve au Sud (dans le bas du listing, vers la fin du programme),
il est nécessaire de le déclarer. jaPBe, un éditeur téléchargeable ne vous ennuie pas avec cette nécessité. [EDIT] >> Oui mais non : Dobro vient de m'apprendre que jaPBe n'a pas non plus la déclaration automatique, donc c'est idem que l'éditeur de base <<

Si vous avez l'éditeur de base, il vous faut rajouter ceci :

Code : Tout sélectionner

Declare Sanctuaire()

; programme principal

Procedure Sanctuaire()
Debug "Lieu saint où s'effectuent des instructions bizarres"
EndProcedure

Grâce à ces rudiments, voici le code qui fonctionne et exécute notre procédure monumentale.

Code : Tout sélectionner

Declare Sanctuaire()

; programme principal
Sanctuaire()

Procedure Sanctuaire()
Debug "Lieu saint où s'effectuent des instructions bizarres"
EndProcedure

[Ollivier]

Variable locale : La variable est une entité finie, un constituant numérique qui prend place dans le sanctuaire. ça peut être un nombre, un pointeur ou chaîne. Pour le programmeur, ça reste un nom qui stocke une valeur.

La variable locale doit être déclarée avec «Protected».

Code : Tout sélectionner

Declare Sanctuaire()

; programme principal
Sanctuaire()

Procedure Sanctuaire()
  Protected QuantiteHabitant.L
  Debug "Lieu saint où s'effectuent des instructions bizarres"
EndProcedure

Elle peut être affichée :

Code : Tout sélectionner

Declare Sanctuaire()

; programme principal
Sanctuaire()

Procedure Sanctuaire()
  Protected QuantiteHabitant.L
  Debug QuantiteHabitant
EndProcedure

Elle peut stocker une valeur:

Code : Tout sélectionner

Declare Sanctuaire()

; programme principal
Sanctuaire()

Procedure Sanctuaire()
  Protected QuantiteHabitant.L
  QuantiteHabitant = 29
  Debug QuantiteHabitant
EndProcedure

Elle peut subir un calcul:

Code : Tout sélectionner

Declare Sanctuaire()

; programme principal
Sanctuaire()

Procedure Sanctuaire()
  Protected QuantiteHabitant.L ; Déclaration
  QuantiteHabitant = 29          ; Stockage de valeur
  QuantiteHabitant + 5            ; Calcul
  Debug QuantiteHabitant        ; Affichage
EndProcedure

Et elle peut être renvoyée à son expéditeur (ici c'est le programme principal):

Code : Tout sélectionner

Declare Sanctuaire()

; programme principal
Debug Sanctuaire()

Procedure Sanctuaire()
  Protected QuantiteHabitant.L ; Déclaration
  QuantiteHabitant = 29          ; Stockage de valeur
  QuantiteHabitant + 5            ; Calcul
  Debug QuantiteHabitant        ; Affichage
  ProcedureReturn QuantiteHabitant ; Sortie (ou retour) de la variable
EndProcedure

Certains illuminés comme moi diront alors que la valeur est sortie du sanctuaire.

Mais ce qui est fondamental, jouissif, impulsif, voire rassurant, c'est le simple fait qu'une procédure reste un sanctuaire bien fermé qui ne mélange pas les noms de variables.

Code : Tout sélectionner

Declare Sanctuaire()

; programme principal
Debug Sanctuaire()
Debug QuantiteHabitant ; Ici, cette valeur contiendra 0 (zéro)

Procedure Sanctuaire()
  Protected QuantiteHabitant.L ; Déclaration
  QuantiteHabitant = 29          ; Stockage de valeur
  QuantiteHabitant + 5            ; Calcul
  Debug QuantiteHabitant        ; Affichage
  ProcedureReturn QuantiteHabitant ; Sortie (ou retour) de la variable
EndProcedure

Ce qui est génial et permet des souplesses accrues.

[Ollivier]

Le pointeur : Petit animal sympa contenant une petite touffe symbolisée par le signe « * »
et qui a pour but d'indiquer un endroit quelconque dans la mémoire vive de votre ordinateur.

Quand on apprivoise mal un petit pointeur, il grogne. C'est-à-dire que l'erreur
«SPECIFIED ADRESS IS NULL» vous tamponne un programme, qu'il soit court ou qu'il soit long.

Code qui permet d'obtenir ce message frustrant:

Code : Tout sélectionner

Procedure Test() ; Mise en place de la procédure
Protected *Tamagoshi
PokeL(*Tamagoshi, 29)
EndProcedure

Test() ; Exécution de la procédure

(Remarque : le programme principal est après la procédure. C'est une de mes vilaines
habitudes)

Une des première règle de base est de lui offrir un lieu de vie dans la mémoire vive.

Code : Tout sélectionner

Procedure Test() ; Mise en place de la procédure
Protected *Tamagoshi ; On déclare le 
*Tamagoshi = AllocateMemory(8)
PokeL(*Tamagoshi, 29)
EndProcedure ; Fin de procédure

Test() ; Exécution de la procédure

Ici on a alloué 8 octets de mémoire pour que le pointeur *Tamagoshi puisse s'y balader.
Attention : ce dernier code est décevant car il ne se passe strictement rien à l'oeil nu. Il
indique juste qu'il tourne sans créer d'erreur.

[Ollivier]

La Structure : La Structure est une demoiselle super cool qu'il faut préparer avec soin.
Comme toute demoiselle, il lui faut du temps pour être prête, mais une fois qu'elle est
prête, elle cartonne.

Une demoiselle se prépare comme suit:

Code : Tout sélectionner

Structure DEESSE
  Nom.S
  Age.L
  Profession.S
EndStructure

Mademoiselle, une fois préparée, demande toujours un tamagoshi:

Code : Tout sélectionner

Structure DEESSE
  Nom.S
  Age.L
  Profession.S
EndStructure

Tamagoshi.DEESSE

Si la petite touffe « * » ne vous dérange pas, voici un code dont le résultat est EXACTEMENT
le même:

Code : Tout sélectionner

Structure DEESSE
  Nom.S
  Age.L
  Profession.S
EndStructure

*Tamagoshi.DEESSE = AllocateMemory(SizeOf(DEESSE) )

Moi, elle ne me dérange pas, donc souvent, cette dernière ligne un peu barbare
vient se glisser dans un des codes que je poste quand une Structure est nécessaire.

Maintenant, grâce au tamagoshi (pointeur), on va déplacer mademoiselle (Structure)
dans un sanctuaire (procédure).

Code : Tout sélectionner

Structure DEESSE ; Melle se prépare...
  Nom.S
  Age.L
  Profession.S
EndStructure ; ...Elle est prête

*Tama.DEESSE = AllocateMemory(SizeOf(DEESSE) ) ; on la déclare grâce à un tamagoshi

Procedure Baptise(*Tama.DEESSE)
  *Tama\Nom = "Irma"
EndProcedure 

  Baptise(*Tama)
  Debug "Bijour, je m'appelle " + *Tama\Nom

Alors, la question qui peut venir au déprimé qui a eu le malheur de lire toute cette page est simple :
POURQUOI SE PRENDRE LA TETE A ECRIRE TOUT CA ALORS QUE L'ON POURRAIT JUSTE
ECRIRE CECI:

Code : Tout sélectionner

Debug "Bijour je m'appelle Irma"

La première réponse apparente est
simple : l'auteur de ce post est un dingo qu'il faut enfermer à quadruple tour dans un coffre
au fond des oubliettes d'un hosto psy loin de toute civilisation.

[Backup]

jaPBe, un éditeur téléchargeable ne vous ennuie pas avec
cette nécessité.

heu t'es sur ??

parce que j'utilise japbe, et je met toujours mes procédures en fin de listing
et si je ne déclare pas , le compilateur rale !!

y aurait il une option dans japbe , que je n'aurai vu ?

[Ar-S]

N'empêche que tu viens d'éclairer un peu plus ma lanterne concernant les tamagoshis.. heu... les pointeurs
Merci

---edit----
Il rale parceque tu l'as pas déclarer je pense.

Code : Tout sélectionner

;Declare coco()
Global coco.s

coco()

Procedure coco()
coco="Bob"
MessageRequester("",coco,#MB_ICONINFORMATION)
EndProcedure

Marche pas

Code : Tout sélectionner

Declare coco()
Global coco.s

coco()

Procedure coco()
coco="Bob"
MessageRequester("",coco,#MB_ICONINFORMATION)
EndProcedure

Marche

[Ollivier]

Ah? Ben merde alors... A parler de choses que l'on n'a pas gouté! Je pensais qu'il déclarait automatiquement sous jaPBe. Ben désolé pour l'intox!

(Sans transition )

L'environnement : L'environnement c'est la partie statique d'un programme qu'il est urgent
de savoir créer.

Code : Tout sélectionner

Debug "Environnement le plus simple qu'il y est en PB..."

Avec un tel code, ci-dessus, on remarque que les concepteurs de PureBasic nous ont gâté :
Une seule ligne et le tour est joué. C'est efficace mais peu acceptable pour le futur utilisateur
d'un programme.

Voici un exemple plus concis:

Code : Tout sélectionner

MessageRequester("Message", "Environnement pour les requêtes")

ça y est! Je suis un pro. Je suis encore plus content à l'idée qu'une seule ligne a suffi pour ça.
Conclusion : youpi.

Pour les nostalgiques des années 80, l'environnement console est toujours accessible:

Code : Tout sélectionner

OpenConsole() ; Ouvre l'environnement de la console
EnableGraphicalConsole(0) ; Affiche la console en 1er plan
Print("Environnement console") ; Affiche un message
Input() ; Attend l'appui de la touche [Entrée]
CloseConsole() ; Ferme la console

Pour les classiques de la fenêtre:

Code : Tout sélectionner

Structure FENETRE
  Numero.L
  LargeurInterne.L
  HauteurInterne.L
  Titre.S
EndStructure

*Fenetre.FENETRE = AllocateMemory(SizeOf(FENETRE) )

Procedure FenetreTailleStandard(*Fenetre.FENETRE)
  With *Fenetre
    \LargeurInterne = 384
    \HauteurInterne = 64
  EndWith
EndProcedure

Procedure Fenetre(*Fenetre.FENETRE)
  With *Fenetre
    \Numero = OpenWindow(-1, 0, 0, \LargeurInterne, \HauteurInterne, \Titre, $CF0001)
  creategadgetlist(WindowID(\Numero) )
  TextGadget(-1, 0, 0, \LargeurInterne, \HauteurInterne, "Environnement classique de base: pas de centrage ni de bouton ok.")
  Repeat
  Until WaitWindowEvent() = 16
  CloseWindow(\Numero)
  EndWith
EndProcedure

FenetreTailleStandard(*Fenetre)
Fenetre(*Fenetre)

Là, ça se complique net... Pour un simple message, on a sorti la trousse à outil pleine d'instructions...
Enfin...

Pour accélérer l'affichage et quitter l'Interface de l'OS, voici un environnement
pseudo-graphique:

Code : Tout sélectionner

Structure ENSEMBLE
  *Bureau
  *Fenetre
EndStructure

Structure BUREAU
  Largeur.L
  Hauteur.L
EndStructure

Structure FENETRE
  Numero.L
  LargeurInterne.L
  HauteurInterne.L
  Titre.S
EndStructure

InitSprite()

*Ensemble.ENSEMBLE = AllocateMemory(SizeOf(ENSEMBLE) )
*Bureau.BUREAU = AllocateMemory(SizeOf(BUREAU) )
*Fenetre.FENETRE = AllocateMemory(SizeOf(FENETRE) )

With *Ensemble
  \Bureau = *Bureau
  \Fenetre = *Fenetre
EndWith

Procedure BureauInterroge(*Bureau.BUREAU)
  With *Bureau
    ExamineDesktops()
    \Largeur = DesktopWidth(0)
    \Hauteur = DesktopHeight(0)
  EndWith
EndProcedure

Procedure FenetreTailleBureau(*Ensemble.ENSEMBLE)
  Protected *Bureau.BUREAU
  Protected *Fenetre.FENETRE
  With *Ensemble
    *Bureau = \Bureau
    *Fenetre = \Fenetre
  EndWith
  
  *Fenetre\LargeurInterne = *Bureau\Largeur
  *Fenetre\HauteurInterne = *Bureau\Hauteur

EndProcedure

Procedure FenetreSansRebord(*Fenetre.FENETRE)
  With *Fenetre
    \Numero = OpenWindow(-1, 0, 0, \LargeurInterne, \HauteurInterne, \Titre, $80000000)
    OpenWindowedScreen(WindowID(\Numero), 0, 0, \LargeurInterne, \HauteurInterne, 0, 0, 0)
    Repeat
      StartDrawing(ScreenOutput() )
        DrawingMode(#PB_2DDrawing_Transparent)
        DrawText(0, 0, "Environnement pseudo-graphique - Appuyez sur [Alt + F4] pour quitter...", #White)
      StopDrawing()
      FlipBuffers()      
    Until WaitWindowEvent() = 16
    CloseWindow(\Numero)
  EndWith
EndProcedure

Procedure PseudoGraphique(*Ensemble.ENSEMBLE)
  With *Ensemble
    BureauInterroge(\Bureau)
    FenetreTailleBureau(*Ensemble)
    FenetreSansRebord(\Fenetre) 
  EndWith
EndProcedure

;******************
; Programme principal
;******************
  
  PseudoGraphique(*Ensemble)

Alors là, c'est le pompon : Tout ça pour un simple message inutile sur un écran noir.
La seule explication que je peux donner pour l'instant, c'est reculer pour mieux sauter.

Pour la création de jeux en plein éccran et demandant un maximum de vitesse :

Code : Tout sélectionner

Structure ENSEMBLE
  *Bureau
  *Screen
EndStructure

Structure BUREAU
  Largeur.L
  Hauteur.L
  Profondeur.L
EndStructure

Structure SCREEN
  Largeur.L
  Hauteur.L
  Profondeur.L
  Titre.S
EndStructure

InitSprite()
InitKeyboard()

*Ensemble.ENSEMBLE = AllocateMemory(SizeOf(ENSEMBLE) )
*Bureau.BUREAU = AllocateMemory(SizeOf(BUREAU) )
*Screen.SCREEN = AllocateMemory(SizeOf(SCREEN) )

With *Ensemble
  \Bureau = *Bureau
  \Screen = *Screen
EndWith

Procedure BureauInterroge(*Bureau.BUREAU)
  With *Bureau
    ExamineDesktops()
    \Largeur = DesktopWidth(0)
    \Hauteur = DesktopHeight(0)
    \Profondeur = DesktopDepth(0)
  EndWith
EndProcedure

Procedure ScreenTailleBureau(*Ensemble.ENSEMBLE)
  Protected *Bureau.BUREAU
  Protected *Screen.SCREEN
  With *Ensemble
    *Bureau = \Bureau
    *Screen = \Screen
  EndWith
  
  *Screen\Largeur = *Bureau\Largeur
  *Screen\Hauteur = *Bureau\Hauteur
  *Screen\Profondeur = *Bureau\Profondeur

EndProcedure

Procedure ScreenPlay(*Screen.SCREEN)
  With *Screen
    OpenScreen(\Largeur, \Hauteur, \Profondeur, \Titre)
    Repeat
      StartDrawing(ScreenOutput() )
        DrawingMode(#PB_2DDrawing_Transparent)
        DrawText(0, 0, "Environnement graphique - Appuyez sur [Echap] pour quitter...", #White)
      StopDrawing()
      FlipBuffers()      
      ExamineKeyboard()
    Until KeyboardPushed(#PB_Key_Escape)
    CloseScreen()
  EndWith
EndProcedure

Procedure Graphique(*Ensemble.ENSEMBLE)
  With *Ensemble
    BureauInterroge(\Bureau)
    ScreenTailleBureau(*Ensemble)
    ScreenPlay(\Screen) 
  EndWith
EndProcedure

;******************
; Programme principal
;******************
  
  Graphique(*Ensemble)
  

Donc, si on récapitule, on a:
1) Environnement rudimentaire (fenêtre de déboguage)
2) Environnement pour les requêtes
3) Environnement pour la console
4) Environnement pour les fenêtres
5) Environnement pseudo-graphique
6) Environnement graphique plein écran avec accélération matérielle

Un problème majeur réside dans l'incompatibilité d'accéder à tous ces environnements
dans un même programme. Il faut donc choisir selon ses besoins...

[Oliv]

J'adore

[djes]

Sympa

[Ollivier]

Le presse-papier : Je vous présente Bouffe-tout le presse-papier. Alors Bouffe-tout, il est
génial :
1) Tout le monde le connait
2) Il est inoubliable : C.V., comme Ctrl-C et Ctrl-V, c'est-à-dire copier et coller
3) Bouffe-tout est plus puissant qu'un déménageur breton. En effet, il vous avale un fauteuil
3ème empire posé dans une application, traverse 3 mètres d'épaisseur de murailles de votre
OS, comme un bon fantôme et puis vous regerbe délicatement le fauteuil stylé dans une
autre pièce, comme si de rien n'était.
4) Bouffe-tout est un ruminant. Il peut y avoir une digestion partielle entre le moment où
il a mangé et le moment où il régurgite.

C'est ce moment de digestion qui nous intéresse. Car on peut exécuter un code
particulier pendant ce temps-là, surnommé «cachet smecta».

Voici un exemple de cachet smecta:

Code : Tout sélectionner

Procedure Smecta() 

  Protected G.S
  
  G = Chr(34)

  Clip.S = GetClipboardText()

  Clip = G + ReplaceString(Clip, G, G + " + Chr(34) + " + G) + G

  SetClipboardText(Clip)
  
EndProcedure

  Smecta()

Pour comprendre, voici un petit meuble Henri IV:

Code : Tout sélectionner

Debug "Je stocke les slips anciens"

Et bien, laissez Bouffe-tout l'avaler (Ctrl-C), gavez-lui une petite exécution de code Smecta,
puis faites régurgiter (Ctrl-V). Et voyez le travail...

/!\ Attention ! >> Une seule et unique dose de Smecta s'il vous plaît, sinon, gros
effets indésirables et irréversibles, clefs en main.

Ici, notre premier cachet smecta transforme 1 ligne de code en donnée de chaîne
stockable dans une Data.

Code : Tout sélectionner

"Debug " + Chr(34) + "Je stocke les slips anciens" + Chr(34) + ""

[Ollivier]

Voilà le 2ème digestif pour Bouffe-tout le presse-papier. Je n'invente rien, par contre, c'est un peu grimançant à expliquer.

Le code suivant est donc une procédure qui va convertir un texte dans le presse-papier (c'est un "smecta" comme j'aime les nommer).

1) Vous avez un code source lambda
2) Vous le copiez
3) Vous exécutez cette procédure en précisant un nom de module (je vais y venir)
4) Vous le collez dans un autre programme
5) Le résultat est une procédure qui stocke le code source copié comme
une DataSection assouplie

Le nom de cette nouvelle procédure contenant en fait du code source non exploitable directement, c'est le nom du module que vous avez précisé à l'étape (3).

En gros, vous avez un code source quelconque:

Code : Tout sélectionner

Debug "Comment ça tu stockes des slips anciens?!?"

Quand vous lui faîtes subir une téléportation avec Bouffe-tout, vous obtenez une procédure qui vous retourne une chaîne dont le contenu est exactement:

Code : Tout sélectionner

Debug "Comment ça tu stockes des slips anciens?!?"

Voilà donc le Smecta amélioré en question:

Code : Tout sélectionner

Procedure Code2ProcStr(ModuleName.S) 

  Protected G.S
  Protected a.L
  Protected i.L
  Protected GFlag.L
  Protected CFlag.L ; Drapeau de copie d'octet
  Protected Extra.S
  Protected LPos.L
  
  G = Chr(34)

  ; Copie le presse-papier dans la chaîne Clip
  Clip.S = GetClipboardText()

  ; Formalise les guillemets (1 caractère " devient une expression Chr(34) )
  Clip = G + ReplaceString(Clip, G, G + "+G+" + G) + G

  ; Supprime les espaces externes aux paires de guillemets
  GFlag = 0
  Extra = ""
  For i = 1 To Len(Clip)
    a = Asc(Mid(Clip, i, 1) )
    If a = 34
      GFlag = 1 - GFlag
    EndIf
    CFlag = 1
    If GFlag = 0
      If a = 32
        CFlag = 0
      EndIf
    EndIf
    If CFlag
      Extra + Chr(a)
    EndIf
  Next i
  Clip = Extra
  
  ;Supprime les paires de guillemets vides
  RemoveString(Clip, "+" + G + G)
  
  ;Formalise les retours chariots
  Clip = ReplaceString(Clip, Chr(13) + Chr(10), G + "+R" + Chr(13) + Chr(10) + "S+" + G)


  Clip = "S=" + Clip
  Clip = "R = Chr(13) + Chr(10)" + Chr(13) + Chr(10) + Clip
  Clip = "G = Chr(34)" + Chr(13) + Chr(10) + Clip
  Clip = "Protected R.S" + Chr(13) + Chr(10) + Clip
  Clip = "Protected G.S" + Chr(13) + Chr(10) + Clip
  Clip = "Protected S.S" + Chr(13) + Chr(10) + Clip
  Clip = "Procedure.S " + ModuleName + "()" + Chr(13) + Chr(10) + Clip + Chr(13) + Chr(10)
  Clip = Clip + "ProcedureReturn S" + Chr(13) + Chr(10)
  Clip = Clip + "EndProcedure" + Chr(13) + Chr(10)
  ; Copie 
  SetClipboardText(Clip)
  
EndProcedure

  NomDuModule.S = "NomDuModule"
  Code2ProcStr(NomDuModule)

[Ollivier]

Grâce au presse-papier et au code ci-dessus, on peut créer un code aussi tordu que le code ci-dessous :

Code : Tout sélectionner

Procedure.S Console()
Protected S.S
Protected G.S
Protected R.S
G = Chr(34)
R = Chr(13) + Chr(10)
S="OpenConsole() ; Ouvre l'environnement de la console "+R
S+"EnableGraphicalConsole(0) ; Affiche la console en 1er plan "+R
S+"Print("+G+"Environnement console"+G+") ; Affiche un message "+R
S+"Input() ; Attend l'appui de la touche [Entrée] "+R
S+"CloseConsole() ; Ferme la console"
ProcedureReturn S
EndProcedure

Procedure.S Classic()
Protected S.S
Protected G.S
Protected R.S
G = Chr(34)
R = Chr(13) + Chr(10)
S="Structure FENETRE "+R
S+"  Numero.L "+R
S+"  LargeurInterne.L "+R
S+"  HauteurInterne.L "+R
S+"  Titre.S "+R
S+"EndStructure "+R
S+""+R
S+"*Fenetre.FENETRE = AllocateMemory(SizeOf(FENETRE) ) "+R
S+""+R
S+"Procedure FenetreTailleStandard(*Fenetre.FENETRE) "+R
S+"  With *Fenetre "+R
S+"    \LargeurInterne = 384 "+R
S+"    \HauteurInterne = 64 "+R
S+"  EndWith "+R
S+"EndProcedure "+R
S+""+R
S+"Procedure Fenetre(*Fenetre.FENETRE) "+R
S+"  With *Fenetre "+R
S+"    \Numero = OpenWindow(-1, 0, 0, \LargeurInterne, \HauteurInterne, \Titre, $CF0001) "+R
S+"  creategadgetlist(WindowID(\Numero) ) "+R
S+"  TextGadget(-1, 0, 0, \LargeurInterne, \HauteurInterne, "+G+"Environnement classique de base: pas de centrage ni de bouton ok."+G+") "+R
S+"  Repeat "+R
S+"  Until WaitWindowEvent() = 16 "+R
S+"  CloseWindow(\Numero) "+R
S+"  EndWith "+R
S+"EndProcedure "+R
S+""+R
S+"FenetreTailleStandard(*Fenetre) "+R
S+"Fenetre(*Fenetre)"+R
S+""
ProcedureReturn S
EndProcedure

Procedure.S Pseudo()
Protected S.S
Protected G.S
Protected R.S
G = Chr(34)
R = Chr(13) + Chr(10)
S="Structure ENSEMBLE "+R
S+"  *Bureau "+R
S+"  *Fenetre "+R
S+"EndStructure "+R
S+""+R
S+"Structure BUREAU "+R
S+"  Largeur.L "+R
S+"  Hauteur.L "+R
S+"EndStructure "+R
S+""+R
S+"Structure FENETRE "+R
S+"  Numero.L "+R
S+"  LargeurInterne.L "+R
S+"  HauteurInterne.L "+R
S+"  Titre.S "+R
S+"EndStructure "+R
S+""+R
S+"InitSprite() "+R
S+""+R
S+"*Ensemble.ENSEMBLE = AllocateMemory(SizeOf(ENSEMBLE) ) "+R
S+"*Bureau.BUREAU = AllocateMemory(SizeOf(BUREAU) ) "+R
S+"*Fenetre.FENETRE = AllocateMemory(SizeOf(FENETRE) ) "+R
S+""+R
S+"With *Ensemble "+R
S+"  \Bureau = *Bureau "+R
S+"  \Fenetre = *Fenetre "+R
S+"EndWith "+R
S+""+R
S+"Procedure BureauInterroge(*Bureau.BUREAU) "+R
S+"  With *Bureau "+R
S+"    ExamineDesktops() "+R
S+"    \Largeur = DesktopWidth(0) "+R
S+"    \Hauteur = DesktopHeight(0) "+R
S+"  EndWith "+R
S+"EndProcedure "+R
S+""+R
S+"Procedure FenetreTailleBureau(*Ensemble.ENSEMBLE) "+R
S+"  Protected *Bureau.BUREAU "+R
S+"  Protected *Fenetre.FENETRE "+R
S+"  With *Ensemble "+R
S+"    *Bureau = \Bureau "+R
S+"    *Fenetre = \Fenetre "+R
S+"  EndWith "+R
S+"  "+R
S+"  *Fenetre\LargeurInterne = *Bureau\Largeur "+R
S+"  *Fenetre\HauteurInterne = *Bureau\Hauteur "+R
S+""+R
S+"EndProcedure "+R
S+""+R
S+"Procedure FenetreSansRebord(*Fenetre.FENETRE) "+R
S+"  With *Fenetre "+R
S+"    \Numero = OpenWindow(-1, 0, 0, \LargeurInterne, \HauteurInterne, \Titre, $80000000) "+R
S+"    OpenWindowedScreen(WindowID(\Numero), 0, 0, \LargeurInterne, \HauteurInterne, 0, 0, 0) "+R
S+"    Repeat "+R
S+"      StartDrawing(ScreenOutput() ) "+R
S+"        DrawingMode(#PB_2DDrawing_Transparent) "+R
S+"        DrawText(0, 0, "+G+"Environnement pseudo-graphique - Appuyez sur [Alt + F4] pour quitter..."+G+", #White) "+R
S+"      StopDrawing() "+R
S+"      FlipBuffers()      "+R
S+"    Until WaitWindowEvent() = 16 "+R
S+"    CloseWindow(\Numero) "+R
S+"  EndWith "+R
S+"EndProcedure "+R
S+""+R
S+"Procedure PseudoGraphique(*Ensemble.ENSEMBLE) "+R
S+"  With *Ensemble "+R
S+"    BureauInterroge(\Bureau) "+R
S+"    FenetreTailleBureau(*Ensemble) "+R
S+"    FenetreSansRebord(\Fenetre) "+R
S+"  EndWith "+R
S+"EndProcedure "+R
S+""+R
S+";****************** "+R
S+"; Programme principal "+R
S+";****************** "+R
S+"  "+R
S+"  PseudoGraphique(*Ensemble)"
ProcedureReturn S
EndProcedure

Procedure.S Graph()
Protected S.S
Protected G.S
Protected R.S
G = Chr(34)
R = Chr(13) + Chr(10)
S="Structure ENSEMBLE "+R
S+"  *Bureau "+R
S+"  *Screen "+R
S+"EndStructure "+R
S+""+R
S+"Structure BUREAU "+R
S+"  Largeur.L "+R
S+"  Hauteur.L "+R
S+"  Profondeur.L "+R
S+"EndStructure "+R
S+""+R
S+"Structure SCREEN "+R
S+"  Largeur.L "+R
S+"  Hauteur.L "+R
S+"  Profondeur.L "+R
S+"  Titre.S "+R
S+"EndStructure "+R
S+""+R
S+"InitSprite() "+R
S+"InitKeyboard() "+R
S+""+R
S+"*Ensemble.ENSEMBLE = AllocateMemory(SizeOf(ENSEMBLE) ) "+R
S+"*Bureau.BUREAU = AllocateMemory(SizeOf(BUREAU) ) "+R
S+"*Screen.SCREEN = AllocateMemory(SizeOf(SCREEN) ) "+R
S+""+R
S+"With *Ensemble "+R
S+"  \Bureau = *Bureau "+R
S+"  \Screen = *Screen "+R
S+"EndWith "+R
S+""+R
S+"Procedure BureauInterroge(*Bureau.BUREAU) "+R
S+"  With *Bureau "+R
S+"    ExamineDesktops() "+R
S+"    \Largeur = DesktopWidth(0) "+R
S+"    \Hauteur = DesktopHeight(0) "+R
S+"    \Profondeur = DesktopDepth(0) "+R
S+"  EndWith "+R
S+"EndProcedure "+R
S+""+R
S+"Procedure ScreenTailleBureau(*Ensemble.ENSEMBLE) "+R
S+"  Protected *Bureau.BUREAU "+R
S+"  Protected *Screen.SCREEN "+R
S+"  With *Ensemble "+R
S+"    *Bureau = \Bureau "+R
S+"    *Screen = \Screen "+R
S+"  EndWith "+R
S+"  "+R
S+"  *Screen\Largeur = *Bureau\Largeur "+R
S+"  *Screen\Hauteur = *Bureau\Hauteur "+R
S+"  *Screen\Profondeur = *Bureau\Profondeur "+R
S+""+R
S+"EndProcedure "+R
S+""+R
S+"Procedure ScreenPlay(*Screen.SCREEN) "+R
S+"  With *Screen "+R
S+"    OpenScreen(\Largeur, \Hauteur, \Profondeur, \Titre) "+R
S+"    Repeat "+R
S+"      StartDrawing(ScreenOutput() ) "+R
S+"        DrawingMode(#PB_2DDrawing_Transparent) "+R
S+"        DrawText(0, 0, "+G+"Environnement graphique - Appuyez sur [Echap] pour quitter..."+G+", #White) "+R
S+"      StopDrawing()"+R
S+"      FlipBuffers()"+R
S+"      Delay(5)"+R
S+"      ExamineKeyboard() "+R
S+"    Until KeyboardPushed(#PB_Key_Escape) "+R
S+"    CloseScreen() "+R
S+"  EndWith "+R
S+"EndProcedure "+R
S+""+R
S+"Procedure Graphique(*Ensemble.ENSEMBLE) "+R
S+"  With *Ensemble "+R
S+"    BureauInterroge(\Bureau) "+R
S+"    ScreenTailleBureau(*Ensemble) "+R
S+"    ScreenPlay(\Screen) "+R
S+"  EndWith "+R
S+"EndProcedure "+R
S+""+R
S+";****************** "+R
S+"; Programme principal "+R
S+";****************** "+R
S+"  "+R
S+"  Graphique(*Ensemble) "
ProcedureReturn S
EndProcedure

Procedure Quit()
  End
EndProcedure

Structure CHOICE
*Adr
Text.S
EndStructure

Global Dim Choice.CHOICE(4)
Choice(0)\Text = "Mode Console"
Choice(0)\Adr = @Console()
Choice(1)\Text = "Mode classique"
Choice(1)\Adr = @Classic()
Choice(2)\Text = "Mode pseudo-graphique"
Choice(2)\Adr = @Pseudo()
Choice(3)\Text = "Mode graphique avec accélération"
Choice(3)\Adr = @Graph()
Choice(4)\Text = "Quitter"
Choice(4)\Adr = @Quit()

Procedure Main()
  Protected Win.L
  Protected Quit.L
  Protected Event.L
  Protected Butt.L
  Protected FileName.S
  Protected ExecFile.S
  ExecFile = #PB_Compiler_Home+"Tmp0001.EXE"
  FileName = #PB_Compiler_Home + "\Tmp0001.PB"
  Win = OpenWindow(-1, 0, 0, 432, 32 * 6, "Menu", $CF0001)
  For i = 0 To 4
    ButtonGadget(i, 16, i * 32 + 16, 400, 24, Choice(i)\Text)
  Next i
  Repeat
    Event = WaitWindowEvent()
    Select Event
      Case 16
        Quit | 1
      Case #PB_Event_Gadget
        HideWindow(Win, 1)
        Butt = EventGadget()
        CreateFile(0, FileName)
        WriteStringN(0, PeekS(CallFunctionFast(Choice(Butt)\Adr) ) )
        CloseFile(0)
        ExtProg = RunProgram(#PB_Compiler_Home+"\Compilers\pbcompiler", FileName + " /EXE " + Chr(34) + "Tmp0001.EXE" + Chr(34), #PB_Compiler_Home, 12|#PB_Program_Hide)
        Sortie$ = ""
        If ExtProg 
          While ProgramRunning(ExtProg)
            ReadProgramString(ExtProg)
          Wend
          RunProgram(#PB_Compiler_Home + "Tmp0001.EXE", "", "", 1)
        EndIf
        DeleteFile("Tmp0001.EXE")
        DeleteFile(FileName)
        HideWindow(Win, 0)
    EndSelect
  Until Quit
  CloseWindow(Win)
EndProcedure

  Main()