Ce code source permet de créer et d'exécuter un code source, en écrivant n'importe quel caractère dans les noms de labels, procédures et variables.
Code : Tout sélectionner
;******************************************************************************************************************************
CompilerIf 0
EnableExplicit
Define.I Fenêtre_Id
Define.I Fenêtre_X
Define.I Fenêtre_Y
Define.I Fenêtre_Largeur
Define.I Fenêtre_Hauteur
Define.I Fenêtre_Options
Define.S Fenêtre_Titre
Define.I Fenêtre_Evènement
Define.I Canvas_Id
Define.I Canvas_X
Define.I Canvas_Y
Define.I Canvas_Largeur
Define.I Canvas_Hauteur
Define.I Canvas_Souris_Boutons
Define.I Canvas_Souris_X
Define.I Canvas_Souris_Y
Define.I Gadget_Concerné
Define.I Evènement_Type
Define.I Action_Pointage
Define.I Action_Tracé
Define.I Dessin_Couleur
Fenêtre_X = 0
Fenêtre_Y = 0
Fenêtre_Largeur = 220
Fenêtre_Hauteur = 220
Fenêtre_Titre = "Canvas"
Fenêtre_Options = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
Canvas_X = 10
Canvas_Y = 10
Canvas_Largeur = 200
Canvas_Hauteur = 200
Fenêtre_Id = OpenWindow(#PB_Any,
Fenêtre_X,
Fenêtre_Y,
Fenêtre_Largeur,
Fenêtre_Hauteur,
Fenêtre_Titre,
Fenêtre_Options)
If Fenêtre_Id
Canvas_Id = CanvasGadget(#PB_Any,
Canvas_X,
Canvas_Y,
Canvas_Largeur,
Canvas_Hauteur)
If Canvas_Id
Repeat
Fenêtre_Evènement = WaitWindowEvent()
If Fenêtre_Evènement = #PB_Event_Gadget
Gadget_Concerné = EventGadget()
If Gadget_Concerné = Canvas_Id
Evènement_Type = EventType()
Canvas_Souris_Boutons = GetGadgetAttribute(Canvas_Id, #PB_Canvas_Buttons)
Canvas_Souris_X = GetGadgetAttribute(Canvas_Id, #PB_Canvas_MouseX)
Canvas_Souris_Y = GetGadgetAttribute(Canvas_Id, #PB_Canvas_MouseY)
Action_Tracé = Bool(Evènement_Type = #PB_EventType_MouseMove)
Action_Tracé & Bool(Canvas_Souris_Boutons & #PB_Canvas_LeftButton)
Action_Pointage = Bool(Evènement_Type = #PB_EventType_LeftButtonDown)
If Action_Pointage Or Action_Tracé
If StartDrawing(CanvasOutput(Canvas_Id))
Dessin_Couleur = RGB(Random(255), Random(255), Random(255) )
Circle(Canvas_Souris_X, Canvas_Souris_Y, 10, Dessin_Couleur)
StopDrawing()
EndIf
EndIf
EndIf
EndIf
Until Fenêtre_Evènement = #PB_Event_CloseWindow
EndIf
EndIf
End
CompilerEndIf
EnableExplicit
Procedure.S Convert(A.I)
Define.S Result
Result = Hex(A)
ProcedureReturn Result
EndProcedure
Procedure.S SourceReplaceNonAscii(LineIn.S)
Define.S LineOut = ""
Define.I I
Define.I LineLength = Len(LineIn)
Define.I A
Define.I DoubleQuoteFlag
Define.I SingleQuoteFlag
Define.I CommentFlag
Define.S LineMid
For I = 1 To LineLength
A = Asc(Mid(LineIn, I, 1) )
LineMid = Chr(A)
If CommentFlag = 0 And DoubleQuoteFlag = 0
If A = 39
SingleQuoteFlag ! 1
EndIf
EndIf
If CommentFlag = 0 And SingleQuoteFlag = 0
If (A = 34)
DoubleQuoteFlag ! 1
Else
If DoubleQuoteFlag = 0
If 1
If A > 127
LineMid = "_" + LCase(Convert(A) )
EndIf
Else
ProcedureReturn " "
EndIf
EndIf
EndIf
EndIf
If DoubleQuoteFlag = 0 And SingleQuoteFlag = 0
If A = 59
CommentFlag = 1
EndIf
EndIf
LineOut + LineMid
Next
ProcedureReturn LineOut
EndProcedure
Procedure CompilerExecuteFile(ProgramParameter.S, ProgramOutputFlag.I = 0)
Define.S ProgramName = "PBCOMPILER.EXE"
Define.S ProgramDirectory = #PB_Compiler_Home + "/COMPILERS/"
Define.I ProgramOption = #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide
Define.I ProgramId = RunProgram(ProgramName, ProgramParameter, ProgramDirectory, ProgramOption)
Define.S ProgramOutput
Define.I ProgramExitCode
Define.S ProgramString
Define.S NextLineChar = Chr(13)
If ProgramId
While ProgramRunning(ProgramId)
If AvailableProgramOutput(ProgramId)
ProgramString = ReadProgramString(ProgramId)
ProgramOutput + ProgramString + NextLineChar
EndIf
Wend
ProgramExitCode = ProgramExitCode(ProgramId)
CloseProgram(ProgramId)
EndIf
If ProgramOutputFlag Or ProgramExitCode
MessageRequester(ProgramName, ProgramOutput)
EndIf
EndProcedure
Procedure SourceExtractHeader(OutputFileName.S)
Define.I InputFileId = OpenFile(#PB_Any, #PB_Compiler_File)
Define.S InputFileString
Define.I InputFileReading
Define.I InputFileBom
Define.I OutputFileId = CreateFile(#PB_Any, OutputFileName)
Define.S FileString
Define.I InputFileLevel
If InputFileId
InputFileBom = ReadStringFormat(InputFileId)
If OutputFileId
While Not Eof(InputFileId)
InputFileString = ReadString(InputFileId)
FileString = UCase(Trim(InputFileString) )
If Left(FileString, 13) = "COMPILERENDIF"
InputFileLevel - 1
If InputFileLevel = 0
InputFileReading = 0
Break
EndIf
EndIf
If Left(FileString, 10) = "COMPILERIF"
InputFileLevel + 1
EndIf
If InputFileReading
InputFileString = SourceReplaceNonAscii(InputFileString)
WriteStringN(OutputFileId, InputFileString)
EndIf
If InputFileString = "CompilerIf 0"
WriteStringN(OutputFileId, "")
InputFileReading = 1
EndIf
If Not InputFileReading
WriteStringN(OutputFileId, "")
EndIf
Wend
CloseFile(OutputFileId)
EndIf
CloseFile(InputFileId)
EndIf
EndProcedure
Define.S TransitFileName = #PB_Compiler_Home + "TRANSIT.PB"
SourceExtractHeader(TransitFileName)
CompilerExecuteFile(TransitFileName)