Retina
Retina
Bonjour voici Retina,
ça permet de visualiser un listing PureBasic, en théorie sur tous les OS.
C'est donc, à la fois une version d'essai, et un partage.
Il a été possible grâce, entre autres, à une contribution publique de Kernadec datant de 2014 (donc merci).
Vous choisissez un listing à visualiser, et voilà.
Il y a le zoom possible : Ctrl + molette
Et les 4 touches clavier.
Si ça bugue, n'hésitez pas à vous plaindre. C'est fait pour.
ça permet de visualiser un listing PureBasic, en théorie sur tous les OS.
C'est donc, à la fois une version d'essai, et un partage.
Il a été possible grâce, entre autres, à une contribution publique de Kernadec datant de 2014 (donc merci).
Vous choisissez un listing à visualiser, et voilà.
Il y a le zoom possible : Ctrl + molette
Et les 4 touches clavier.
Si ça bugue, n'hésitez pas à vous plaindre. C'est fait pour.
Re: Retina
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
Re: Retina
Ca marche.
Helas, il n'y a pas d'ascenseur pour scroller.
Egalement, la police est "tres" grosse; quoi que...
Helas, il n'y a pas d'ascenseur pour scroller.
Egalement, la police est "tres" grosse; quoi que...
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Re: Retina
Meuh tais-toi, toi ! Et joyeusement anniversaire !!
Re: Retina
heu ... c'est normal ça ??
car , cela me parait etre un bien gros code pour dessiner des rectangles de couleurs non ?
car , cela me parait etre un bien gros code pour dessiner des rectangles de couleurs non ?
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Re: Retina
@Zorro
Est-ce que tu peux tester le mode "Handicap visuel" dans les thèmes de ton OS, et apporter un screenshoot?
Est-ce que tu peux tester le mode "Handicap visuel" dans les thèmes de ton OS, et apporter un screenshoot?
Re: Retina
Dans windows 10 il n'y as pas a ma connaissance de theme "Handicap Visuel"
on peut éventuellement dans les "options d'ergonomie", jouer sur le thème avec des modes de contraste élevés ....
ce que j'ai fait, ça ne change rien ! seulement les couleurs sont différentes , mais le résultat est le même
on peut éventuellement dans les "options d'ergonomie", jouer sur le thème avec des modes de contraste élevés ....
ce que j'ai fait, ça ne change rien ! seulement les couleurs sont différentes , mais le résultat est le même
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Re: Retina
1er essai écran noir, curseur mobile ctrl+molette, curseur clignotant fonctionnel et grossit/réduit, aucun texte...
2ème pareil que zorro, même affichage...
windows 10, pas de thème particulier et avec le thème windows10 - pareil
pat
2ème pareil que zorro, même affichage...
windows 10, pas de thème particulier et avec le thème windows10 - pareil
pat
Re: Retina
Windows 8 : fonctionne en mode normal
ne fonctionne pas en thème "handicap visuel" (mode inversé)
J'attends les résultats sous Linux, pour savoir la modif à faire.
ne fonctionne pas en thème "handicap visuel" (mode inversé)
J'attends les résultats sous Linux, pour savoir la modif à faire.
Re: Retina
Bonjour,
Voila une capture avec "Linux Mint" en VM, tout pareil que tout le monde. Pour infos j'ai fait le test sur Win7 et même résultat aussi.
GallyHC
Voila une capture avec "Linux Mint" en VM, tout pareil que tout le monde. Pour infos j'ai fait le test sur Win7 et même résultat aussi.
GallyHC
Configuration : Tower: Windows 10 (Processeur: i7 "x64") (Mémoire: 16Go) (GeForce GTX 760 - 2Go) - PureBasic 5.72 (x86 et x64)
Re: Retina
si le but c'est d'avoir un code coloré dans un editeur
avec tabulation
j'avais fait ça , il y a un moment :
http://www.purebasic.fr/french/viewtopi ... ab#p184216
(faut copier-coller le code dans l'editeur , ajouter un Load_pb ne serai vraiment pas compliqué )
mais bon ...
avec tabulation
j'avais fait ça , il y a un moment :
http://www.purebasic.fr/french/viewtopi ... ab#p184216
(faut copier-coller le code dans l'editeur , ajouter un Load_pb ne serai vraiment pas compliqué )
mais bon ...
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Re: Retina
Pour l'instant, il n'y a qu'un heureux le jour de son anniversaire et qui me demande d'y mettre un ascenseur!
Ce serait intéressant sur Linux, mais pas seulement en VM.
Ce serait intéressant sur Linux, mais pas seulement en VM.
Re: Retina
vu que tu utilises le openglgadget, ne faut il pas spécifier le sous system direct9 ou un truc du genre dans les directive du compilateur ?
pat
pat
Re: Retina
@Patrick88
Je crains que ça soit un poil plus complexe que ça. J'attends vraiment qu'un linuxien donne une observation. En théorie, ça devrait être bon.
La chance que je peux avoir c'est d'être sur un OS qui donne les deux cas : bon et mauvais.
Mais alors le coup du SPH qui est le seul à le voir fonctionner, ça, j'aurai voulu le faire que je n'aurais pas réussi...
Je crains que ça soit un poil plus complexe que ça. J'attends vraiment qu'un linuxien donne une observation. En théorie, ça devrait être bon.
La chance que je peux avoir c'est d'être sur un OS qui donne les deux cas : bon et mauvais.
Mais alors le coup du SPH qui est le seul à le voir fonctionner, ça, j'aurai voulu le faire que je n'aurais pas réussi...
Re: Retina
Sous linux (dérivé de ubuntu 64 bits : GALLIUM OS) avec purebasic 5.60 x64 :
écran noir avec un curseur qu'on peut déplacer avec les touches fléchées.
J'ai chargé un simple fichier texte (readme de purebasic).
Sous windows 10 x64 j'ai les mêmes patés de couleurs que les autres.
.......
Bon en fait j'ai tenté de charger un source pb et j'obtiens sous linux la même chose que sous windows : des pavés de couleurs symbolisant le texte et un curseur déplaçable.
écran noir avec un curseur qu'on peut déplacer avec les touches fléchées.
J'ai chargé un simple fichier texte (readme de purebasic).
Sous windows 10 x64 j'ai les mêmes patés de couleurs que les autres.
.......
Bon en fait j'ai tenté de charger un source pb et j'obtiens sous linux la même chose que sous windows : des pavés de couleurs symbolisant le texte et un curseur déplaçable.