Code : Tout sélectionner
Define FullName.S
FullName = OpenFileRequester("Open", "", "", 0)
Structure Tex
ID.I
Image.I
Width.I
Height.I
*DrawBuffer
EndStructure
Procedure WorkGadget(Gadget.I, X.I, Y.I, W.I, H.I)
Define Result.I
Result = OpenGLGadget(Gadget, X, Y, W, H, #PB_OpenGL_Keyboard)
If Result
If Gadget = #PB_Any
Gadget = Result
EndIf
SetGadgetAttribute(Gadget, #PB_OpenGL_SetContext, #True)
glViewport_(0, 0, W, H)
glMatrixMode_(#GL_PROJECTION)
glLoadIdentity_()
glOrtho_(0, W, H, 0, 0, 1)
ProcedureReturn Gadget
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure WorkClear(Gadget.I, R.F, G.F, B.F, A.F)
SetGadgetAttribute(Gadget, #PB_OpenGL_SetContext, #True)
glClear_(#GL_COLOR_BUFFER_BIT)
glClearColor_(R, G, B, A)
EndProcedure
Procedure WorkBlend(E0.I, E1.I)
glEnable_(#GL_BLEND)
glBlendFunc_(E0, E1)
EndProcedure
Procedure TexCreate(Width.I, Height.I)
*This.Tex = AllocateMemory(SizeOf(Tex) )
*This\Width = Width
*This\Height = Height
*This\Image = CreateImage(#PB_Any, *This\Width, *This\Height, 32)
If StartDrawing(ImageOutput(*This\Image) )
*This\DrawBuffer = DrawingBuffer()
StopDrawing()
ProcedureReturn *This
EndIf
EndProcedure
Procedure TexMake(*This.Tex)
glGenTextures_(1, @*This\ID)
glBindTexture_(#GL_TEXTURE_2D, *This\ID)
glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MIN_FILTER, #GL_LINEAR)
glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MAG_FILTER, #GL_LINEAR)
glTexImage2D_(#GL_TEXTURE_2D, 0, 4, *This\Width, *This\Height, 0, #GL_BGRA_EXT, #GL_UNSIGNED_BYTE, *This\DrawBuffer)
EndProcedure
Procedure TexDisplay(*This.Tex, X.F, Y.F, Wc.F = 1.0, Hc.F = 1.0)
glClear_(#GL_DEPTH_BUFFER_BIT)
glEnable_(#GL_TEXTURE_2D)
glBindTexture_(#GL_TEXTURE_2D, *This\ID)
glBegin_(#GL_QUADS)
glTexCoord2f_(0.0, 1.0) ; ToLe
glVertex2f_(X, Y)
glTexCoord2f_(0.0, 0.0) ; BoLe
glVertex2f_(X, Y + *This\Height * Hc)
glTexCoord2f_(1.0, 0.0) ; BoRi
glVertex2f_(X + *This\Width * Wc, Y + *This\Height * Hc)
glTexCoord2f_(1.0, 1.0) ; ToRi
glVertex2f_(X + *This\Width * Wc, Y)
glEnd_()
EndProcedure
Procedure MaskDisplay(*This.Tex, X.F, Y.F, W.F, H.F, R.F, G.F, B.F)
glColor4f_(R, G, B, 1.0)
glTexCoord2f_(0.0, 1.0) ; ToLe
glVertex2f_(X, Y)
glTexCoord2f_(0.0, 0.0) ; BoLe
glVertex2f_(X, Y + H)
glTexCoord2f_(1.0, 0.0) ; BoRi
glVertex2f_(X + W, Y + H)
glTexCoord2f_(1.0, 1.0) ; ToRi
glVertex2f_(X + W, Y)
EndProcedure
Global Dim LA.S(31) ; (L)ast (A)scii
Global Dim LR.F(31)
Global Dim LG.F(31)
Global Dim LB.F(31)
Procedure LaSet(n, Name.S, r.F, g.F, b.F)
LA(n) = Name
LR(n) = r
LG(n) = g
LB(n) = b
EndProcedure
Procedure MarkDisplay(*This.Tex, String.S, X.F, Y.F, Wc.F = 1.0, Hc.F = 1.0)
LaSet(0, "PROCEDURE", 0.0, 0.5, 0.0)
LaSet(1, "ENDPROCEDURE", 0.0, 0.5, 0.0)
LaSet(2, "WITH", 0.5, 0.5, 0.0)
LaSet(3, "ENDWITH", 0.5, 0.5, 0.0)
LaSet(4, "IF", 0.0, 0.0, 0.5)
LaSet(5, "ENDIF", 0.0, 0.0, 0.5)
LaSet(6, "FOR", 0.0, 0.5, 0.5)
LaSet(7, "NEXT", 0.0, 0.5, 0.5)
LaSet(8, "TO", 0.0, 0.5, 0.5)
LaSet(9, "GLOBAL", 0.0, 0.5, 0.0)
LaSet(10, "STRUCTURE", 0.0, 0.3, 0.0)
LaSet(11, "ENDSTRUCTURE", 0.0, 0.3, 0.0)
LaSet(12, "DEFINE", 0.0, 0.5, 0.0)
LaSet(13, "REPEAT", 0.0, 0.5, 0.0)
LaSet(14, "UNTIL", 0.0, 0.5, 0.0)
LaSet(15, "ELSE", 0.0, 0.0, 0.5)
Define.I A, I, LString
Define.F xA, yA, xB, yB
Define.S Expr
LString = Len(String)
For I = 1 To Len(String) + 1
A = Asc(Mid(String, I, 1) )
If A = Asc(";")
MaskDisplay(*This.Tex, I * 10 * Wc, Y, (LString - I) * 10 * Wc, 20 * Hc, 0.6, 0.25, 0.25)
Break
EndIf
If A = 34
I1 = I + 1
I2 = FindString(String, Chr(34), I1)
MaskDisplay(*This.Tex, (I1 - 1) * 10 * Wc, Y, ((I2 - I1) ) * 10 * Wc, 20 * Hc, 1.0, 0.2, 0.1)
Delta = ((I2 - I1) + 1)
I + Delta
X + (Delta * (10.0 * Wc) )
EndIf
If (A > 96) And (A < 123)
A - 32
EndIf
If (((A > 64) And (A < 91) ) Or ((A > 47) And (A < 58) ) ) Or (A = Asc("_") )
If Start = 0
Start = I
EndIf
Expr + Chr(A)
Else
For J = 0 To 15
LLA = Len(LA(J) )
If Right(Expr, LLA) = LA(J)
MaskDisplay(*This.Tex, ((Start - 1) * 10 * Wc), Y, (LLA * 10 * Wc), (20 * Hc), LR(J), LG(J), LB(J) )
EndIf
Next
Start = 0
Expr = ""
EndIf
X + (10.0 * Wc)
Next
MaskDisplay(*This, X, Y, W, H, R, G, B)
EndProcedure
Procedure JustDisplay(*This.Tex, X.F, Y.F, W.F, H.F)
glTexCoord2f_(0.0, 1.0) ; ToLe
glVertex2f_(X, Y)
glTexCoord2f_(0.0, 0.0) ; BoLe
glVertex2f_(X, Y + H)
glTexCoord2f_(1.0, 0.0) ; BoRi
glVertex2f_(X + W, Y + H)
glTexCoord2f_(1.0, 1.0) ; ToRi
glVertex2f_(X + W, Y)
EndProcedure
Procedure CharBegin(*This.Tex)
glClear_(#GL_DEPTH_BUFFER_BIT)
glEnable_(#GL_TEXTURE_2D)
glBindTexture_(#GL_TEXTURE_2D, *This\ID)
glBegin_(#GL_QUADS)
EndProcedure
Structure WorkFont
x0.F
y0.F
x1.F
y1.F
EndStructure
Procedure CharDisplay(A.I, X.F, Y.F, Array Char.WorkFont(1), Wc.F = 1.0, Hc.F = 1.0)
Define.F xA, yA, xB, yB
xA = Char(A)\x0
yA = Char(A)\y0
xB = Char(A)\x1
yB = Char(A)\y1
glTexCoord2f_(xA, yB) ; ToLe
glVertex2f_(X, Y)
glTexCoord2f_(xA, yA) ; BoLe
glVertex2f_(X, Y + 20 * Hc)
glTexCoord2f_(xB, yA) ; BoRi
glVertex2f_(X + 10 * Wc, Y + 20 * Hc)
glTexCoord2f_(xB, yB) ; ToRi
glVertex2f_(X + 10 * Wc, Y)
EndProcedure
Procedure StringDisplay(String.S, X.F, Y.F, Array Char.WorkFont(1), Wc.F = 1.0, Hc.F = 1.0)
Define.I A, I, LString
Define.F xA, yA, xB, yB
LString = Len(String)
For I = 1 To Len(String)
A = Asc(Mid(String, I, 1) )
xA = Char(A)\x0
yA = Char(A)\y0
xB = Char(A)\x1
yB = Char(A)\y1
glTexCoord2f_(xA, yB) ; ToLe
glVertex2f_(X, Y)
glTexCoord2f_(xA, yA) ; BoLe
glVertex2f_(X, Y + 20 * Hc)
glTexCoord2f_(xB, yA) ; BoRi
glVertex2f_(X + 10 * Wc, Y + 20 * Hc)
glTexCoord2f_(xB, yB) ; ToRi
glVertex2f_(X + 10 * Wc, Y)
X + (10.0 * Wc)
Next
EndProcedure
Procedure TexDraw(Array *Tex.Tex(1), I.I, W.I, H.I, *DrawProc)
*Tex(I) = TexCreate(W, H)
If StartDrawing(ImageOutput(*Tex(I)\Image) )
DrawingMode(#PB_2DDrawing_AllChannels)
CallFunctionFast(*DrawProc, W, H)
StopDrawing()
EndIf
EndProcedure
Procedure StdFont(W.I, H.I, Array Char.WorkFont(1), *Tex.Tex)
Define.F xA, yA, xB, yB
Define C.I = RGBA(0, 0, 0, 0)
If StartDrawing(ImageOutput(*Tex\Image) )
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0, 0, W, H, C)
DrawingFont(FontID(1) )
For Y = 0 To 11
For X = 0 To 15
I = Y * 16 + X + 32
If I > 127
I + 32
EndIf
xA = X * 10
yA = Y * 20
DrawText(xA, yA, Chr(I), RGBA(255, 255, 255, 255), C)
yA = (H - 20) - yA
xB = xA + 10
yB = yA + 20
xA / W
yA / H
xB / W
yB / H
Char(I)\x0 = xA
Char(I)\y0 = yA
Char(I)\x1 = xB
Char(I)\y1 = yB
Next
Next
StopDrawing()
EndIf
EndProcedure
Procedure BlankDraw(W.I, H.I)
Box(0, 0, W, H, RGBA(255, 255, 255, 255) )
EndProcedure
Procedure LineCursorDraw(W.I, H.I)
Box(0, 0, W, H, RGBA(255, 255, 255, 255) )
Box(0, 1, W, 2, RGBA(191, 191, 191, 63) )
Box(0, H - 2, W, 2, RGBA(191, 191, 191, 63) )
Box(0, 0, W, 1, RGBA(0, 0, 0, 255) )
Box(0, H - 1, W, 1, RGBA(0, 0, 0, 255) )
EndProcedure
Global FileFormat
Procedure.I FileLoad(Name.S)
File = ReadFile(#PB_Any, Name)
FileFormat = ReadStringFormat(File)
If File
Size = Lof(File)
*T = AllocateMemory(Size)
Reading = ReadData(File, *T, Size)
CloseFile(File)
EndIf
If Reading
ProcedureReturn *T
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure TextLoad(Name.S, Array TextLine.S(1) )
Define *Text = FileLoad(Name)
Define Text.S = PeekS(*Text, MemorySize(*Text), FileFormat)
FreeMemory(*Text)
Define I, LinesCount = CountString(Text, Chr(13) )
Dim TextLine.S(LinesCount)
For I = 1 To LinesCount
TextLine(I) = RemoveString(StringField(Text, I, Chr(13) ), Chr(10) )
Next
ProcedureReturn LinesCount
EndProcedure
Dim *Tex.Tex(2)
Dim Char.WorkFont(255)
Define Zoom.F = 1.0
Define LinesCount
Dim TextLine.S(1)
LinesCount = TextLoad(FullName, TextLine() )
LoadFont(1, "courier new", 13, #PB_Font_Bold)
*Tex(0) = TexCreate(160, 240)
StdFont(160, 240, Char(), *Tex(0) )
TexDraw(*Tex(), 1, 10, 20, @LineCursorDraw() )
TexDraw(*Tex(), 2, 1, 1, @BlankDraw() )
Change = 2
If OpenWindow(0, 0, 0, 1024, 768, "Retina", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
W = WindowWidth(0)
H = WindowHeight(0)
WorkGadget(0, 0, 0, W, H)
TexMake(*Tex(0) )
TexMake(*Tex(1) )
TexMake(*Tex(2) )
SetActiveGadget(0)
AddWindowTimer(0, 1, 16)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Timer
EndIf
EventType = EventType()
If EventType = #PB_EventType_KeyDown
Key = GetGadgetAttribute(0, #PB_OpenGL_Key)
KeyM = GetGadgetAttribute(0, #PB_OpenGL_Modifiers)
If KeyM = #PB_OpenGL_Control
ControlKey = 1
EndIf
If Key = #PB_Shortcut_Up
If CursorY > 0
CursorY - 20
Change + 1
Else
TextOffsetH - 1
Change + 1
EndIf
EndIf
If Key = #PB_Shortcut_Down
If CursorY <= (H / Zoom) - 40
CursorY + 20
Change + 1
Else
TextOffsetH + 1
Change + 1
EndIf
EndIf
If Key = #PB_Shortcut_Left
If CursorX > 0
CursorX - 10
Change + 1
EndIf
EndIf
If Key = #PB_Shortcut_Right
If CursorX <= (W / Zoom) - 20
CursorX + 10
Change + 1
EndIf
EndIf
EndIf
If EventType = #PB_EventType_MouseWheel
If ControlKey
Zoom + (GetGadgetAttribute(0, #PB_OpenGL_WheelDelta) / 10.0)
ControlKey = 0
Change + 1
Else
TextOffsetH - (3 * GetGadgetAttribute(0, #PB_OpenGL_WheelDelta) )
Change + 1
EndIf
EndIf
If EventType = #PB_EventType_MouseMove
Sx = GetGadgetAttribute(0, #PB_OpenGL_MouseX)
Sy = GetGadgetAttribute(0, #PB_OpenGL_MouseY)
EndIf
If Event = #PB_Event_SizeWindow
ResizeGadget(0, 0, 0, WindowWidth(0), WindowHeight(0) )
EndIf
If Event = #PB_Event_Repaint
Change + 2
EndIf
If Change
WorkClear(0, 1.0, 1.0, 1.0, 0.0)
WorkBlend(#GL_SRC_ALPHA, #GL_DST_COLOR) ; Ok srca;dstc
CharBegin(*Tex(0) )
LineHMax = ((H / 20) / Zoom) - 1
If LineHMax > LinesCount
LineHMax = LinesCount
EndIf
If TextOffsetH < 0
TextOffsetH = 0
EndIf
If TextOffsetH + LineHMax => LinesCount
TextOffsetH = LinesCount - LineHMax - 1
EndIf
For LineH = 0 To LineHMax
x.F = 0.0 * Zoom
y.F = LineH * 20.0 * Zoom
StringDisplay(TextLine(LineH + 1 + TextOffsetH), x, y, Char(), Zoom, Zoom)
Next
glEnd_()
WorkBlend(#GL_DST_ALPHA, #GL_ONE_MINUS_DST_ALPHA) ; Ok dsta;NegDstA
CharBegin(*Tex(2) )
MaskDisplay(*Tex(2), 0.0, 0.0, W, H, 0.0, 0.0, 0.0)
For LineH = 0 To LineHMax
x.F = 0.0 * Zoom
y.F = LineH * 20.0 * Zoom
MarkDisplay(*Tex(2), TextLine(LineH + 1 + TextOffsetH), X, Y, Zoom, Zoom)
Next
glEnd_()
glColor4f_(1.0, 1.0, 1.0, 0.0)
WorkBlend(#GL_SRC_ALPHA, #GL_SRC_COLOR)
CharBegin(*Tex(1) )
JustDisplay(*Tex(1), 0.0 * Zoom, CursorY * Zoom, W, 20.0 * Zoom)
glEnd_()
WorkBlend(#GL_ONE_MINUS_DST_COLOR, #GL_ONE_MINUS_DST_COLOR)
CharBegin(*Tex(2) )
JustDisplay(*Tex(2), CursorX * Zoom, CursorY * Zoom, 2.0 * Zoom, 20.0 * Zoom)
glEnd_()
glColor4f_(0.0, 0.0, 0.0, 1.0)
SetGadgetAttribute(0, #PB_OpenGL_FlipBuffers, #True)
Change - 1
EndIf
Until Event = #PB_Event_CloseWindow
EndIf