photos writings music about

<- prev | next ->

DWGLGUI



Namespace GUI

#Define MAX_GUIOBJ_SETS            4

Dim Shared guiSet(1 To MAX_GUIOBJ_SETS) As _gui_
Dim Shared As Integer c_gui
Dim Shared As Integer FPS_LIMIT

Constructor _gui_
      visible = TRUE
End Constructor

Constructor _gui_obj_
      c1 = RGB(100,100,130)
      c2 = RGB(200,200,255)
      c3 = RGB(50,50,80)
      ct = _White
      cs = 0
      cscale = .25
      font = 1
      ls = 10
      txt = Space(256)
      border = TRUE
      visible = TRUE
End Constructor

Sub _gui_obj_.Init_Self()
      With This
            Select Case .kind
            Case guiObjKind.InputBox
                  .inb.cc = 1
                  .txt = Space(256)
            End Select
      End With
End Sub

Sub _gui_obj_.Reset_Self()
      '' Resume default properties when there is no user interaction.
      With This
      If .kind = guiObjKind.Button Then
            If .btn.switch = FALSE Then .btn.d = FALSE
      EndIf
      End With
End Sub

Sub _gui_obj_.Draw_Self(hasFocus As Integer=FALSE)
      #Define dgs default_gui_scale      '' dgs means default gui scale
      #Define dfs default_font_scale      '' dfs means default font scale
      If This.visible = FALSE Then Exit Sub
      With This
      Dim As Integer first_char_w = font_spr((.font*96-96)+1).p->Width
      Dim As Integer first_char_h = font_spr((.font*96-96)+1).p->Height
      If .kind = guiObjKind.Form Then
            GL.box_filled(.x,.y,.x+.w-2,.y+.h-2,.c2)                  '' light border
            GL.box_filled(.x+1,.y+1,.x+.w-1,.y+.h-1,.c3)            '' dark border
            GL.box_filled(.x+1,.y+1,.x+.w-2,.y+.h-2,.c1)            '' fill
            GL.box_filled(.x+1,.y+1,.x+.w-2,.y+1+.ls,.c3)            '' title bar
            text(.x+2+.cs,.y+3,RTrim(.txt),.ct,.font,,.cs,.ls,.cscale)
      ElseIf .kind = guiObjKind.Button Then
            If .btn.d = FALSE Then
                  GL.box_filled(.x,.y,.x+.w-2,.y+.h-2,.c2)
                  GL.box_filled(.x+1,.y+1,.x+.w-1,.y+.h-1,.c3)
                  GL.box_filled(.x+1,.y+1,.x+.w-2,.y+.h-2,.c1)
                  text(.x+.w\2,.y+.h\2,RTrim(.txt),.ct,.font,,.cs,.ls,.cscale,align_c,valign_c)
            ElseIf .btn.d = TRUE Then
                  GL.box_filled(.x,.y,.x+.w-2,.y+.h-2,.c3)
                  GL.box_filled(.x+1,.y+1,.x+.w-1,.y+.h-1,.c2)
                  GL.box_filled(.x+1,.y+1,.x+.w-2,.y+.h-2,.c1)
                  text(.x+.w\2,.y+.h\2,RTrim(.txt),.ct,.font,,.cs,.ls,.cscale,align_c,valign_c)
            EndIf
      ElseIf .kind = guiObjKind.Textbox Then
            If .border Then
                  GL.box_filled(.x,.y,.x+.w-2,.y+.h-2,.c3)
                  GL.box_filled(.x+1,.y+1,.x+.w-1,.y+.h-1,.c2)
                  GL.box_filled(.x+1,.y+1,.x+.w-2,.y+.h-2,.c1)
            Else
                  GL.box_filled(.x,.y,.x+.w-1,.y+.h-1,.c1)
            EndIf
            text(.x+2,.y+3,RTrim(.txt),.ct,.font,,.cs,.ls,.cscale)
      ElseIf .kind = guiObjKind.ListBox Then
            If .border Then
                  GL.box_filled(.x,.y,.x+.w-2,.y+.h-2,.c3)
                  GL.box_filled(.x+1,.y+1,.x+.w-1,.y+.h-1,.c2)
                  GL.box_filled(.x+1,.y+1,.x+.w-2,.y+.h-2,.c1)
            Else
                  GL.box_filled(.x,.y,.x+.w-1,.y+.h-1,.c1)
            EndIf
            If .lst.s Then GL.box_filled(.x+1,.y+1+.lst.s*.ls-.ls,.x+.w-2,.y+1+.lst.s*.ls,.c3)
            For i As Integer = 1 To .lst.c
                  'text(.x+6,.y+1+.ls\2+i*.ls-.ls-1,RTrim(.lst.txt(i)),.ct,.font,,.cs,.ls,.cscale)
                  text(.x+2,.y+2+i*.ls-.ls,RTrim(.lst.txt(i)),.ct,.font,,.cs,.ls,.cscale)
            Next
      ElseIf .kind = guiObjKind.CheckBox Then
            GL.box(.x,.y,.x+.w-1,.y+.h-1,.c3)
            GL.box(.x+1,.y+1,.x+.w-1,.y+.h-1,.c2)
            GL.box_filled(.x+1,.y+1,.x+.w-2,.y+.h-2,.c1)
            If .chk.vlu = TRUE Then
                  GL.circle_2d_filled(.x+.w\2,.y+.h\2,.w\2-1,_Black)
            EndIf
            text(.x+.w+6,.y+.h\2-.ls\2,RTrim(.txt),.ct,.font,,.cs,.ls,.cscale)
      ElseIf .kind = guiObjKind.InputBox Then
            GL.box(.x,.y,.x+.w-1,.y+.h-1,.c3)
            GL.box(.x+1,.y+1,.x+.w-1,.y+.h-1,.c2)
            GL.box_filled(.x+1,.y+1,.x+.w-2,.y+.h-2,.c1)
            text(.x+2,.y+.h\2,RTrim(.txt),.ct,.font,,.cs,.ls,.cscale,,vAlign_C)
            If Timer - .inb.tmr > .6 Then
                  .inb.tmr = Timer
            ElseIf Timer - .inb.tmr > .3 Then
                  If hasFocus Then GL.box_filled(.x+.inb.cc*first_char_w*.cscale-first_char_w*.cscale,.y+1,.x+.inb.cc*first_char_w*.cscale-first_char_w*.cscale+2,.y+.h-2,.ct)
            End If
      EndIf
      End With
End Sub

Function _gui_obj_.MouseDown(mx As Integer, my As Integer, mb As Integer, pmb As Integer) As Integer
      '' Moved to _GUI_.Events
      Return 0
End Function

Function _gui_obj_.MouseUp(mb As Integer) As Integer
      With This
            If .kind = guiObjKind.Button Then
                  .btn.d = FALSE
            ElseIf .kind = guiObjKind.CheckBox Then
                  .chk.vlu Xor = TRUE
            EndIf
      End With
      Return 0
End Function

Function _gui_obj_.KeyDown(ink As ZString Ptr) As Integer
      With This
            Dim As String in = *ink
            If .kind = guiObjKind.InputBox Then
                  Select Case Asc(Left(in,1))
                  Case 255      '' Arrow keys
                        If Asc(Right(*ink,1)) = 75 Then .inb.cc -= 1
                        If Asc(Right(*ink,1)) = 77 Then .inb.cc += 1
                  Case 8            '' Backspace
                        .inb.cc -= 1
                        If .inb.cl>0 Then Mid(.txt,.inb.cc,1) = " "
                  Case 32 To 126 ' 44, 46, 48 To 57, 65 To 90, 97 To 122
                        If .inb.cl>0 Then Mid(.txt,.inb.cc,1) = Left(*ink,1)
                        .inb.cc+=1
                  End Select
                  If .inb.cc > .inb.cl Then .inb.cc = .inb.cl
                  If .inb.cc < 1 Then .inb.cc = 1
                  .inb.tmr = Timer - .8
            EndIf
      End With
      Return 0
End Function

Function gui_available() As Integer
      For n As Integer = 1 To MAX_GUIOBJ_SETS
            If guiSet(n).count = 0 Then Return n
      Next
      Beep: db_write("No gui spaces available.")
      Return 0
End Function

Sub _gui_.events(mx As Integer, my As Integer, mb As Integer, pMB As Integer, ink As ZString Ptr = 0)
      Static As Integer grabbed, grab_x, grab_y
      With This
            .reset_objs()
            If mb = 0 AndAlso pMB = 1 Then
                  grabbed = FALSE
                  .cobj = .obj_at_xy(mx,my)
                  If .cobj Then .o(.cobj).MouseUp(mb)
            ElseIf mb = 1 AndAlso pmb = 0 Then
                  .cobj = .obj_at_xy(mx,my)
                  'If .cobj Then .o(.cobj).MouseDown(mx,my,mb,pmb)
                  With this.o(.cobj)
                             
                        If .kind = guiObjKind.Form Then
                             
                              '' Mouse-down just happened on form title bar:
                              If PointInBox(mx,my,.x,.y,.x+.w-1,.y+10) Then
                                    '' Freeze positions so we can calculate new object and child object positions:
                                    grabbed = TRUE
                                    grab_x = mx : grab_y = my
                                    .prvx = .x
                                    .prvy = .y
                                    With This
                                          For n As Integer = 1 To .count
                                                If .o(n).par = .cobj Then
                                                      .o(n).prvx = .o(n).x
                                                      .o(n).prvy = .o(n).y
                                                EndIf
                                          Next
                                    End With
                              EndIf
                             
                        EndIf
                  End With
           
            ElseIf mb = 1 And pmb = 1 Then

                  With this.o(.cobj)
                        If .kind = guiObjKind.Button Then
                              .btn.d = TRUE
                             
                        ElseIf .kind = guiObjKind.ListBox Then
                              .lst.s = (my-.y)\.ls + 1
                              If .lst.s < 1 Then .lst.s = 1
                              If .lst.s > .lst.c Then .lst.s = .lst.c
                        EndIf
                  End With
                 
                  '' Mouse-down continues for a grabbed object:
                  If grabbed Then
                        With this.o(.cobj)
                              .x = .prvx + -(grab_x-mx)
                              .y = .prvy + -(grab_y-my)
                        End With
                        With This
                              For n As Integer = 1 To .count
                                    If .o(n).par = .cobj Then
                                          .o(n).x = .o(n).prvx + (.o(.cobj).x-.o(.cobj).prvx)
                                          .o(n).y = .o(n).prvy + (.o(.cobj).y-.o(.cobj).prvy)
                                    EndIf
                              Next
                        End With
                  EndIf
            ElseIf mb = 4 Then
                  '' Dev help
                  msgbox(.o(.obj_at_xy(mx,my)).id)
            EndIf
            If Len(Trim(*ink)) Then
                  If .cobj Then .o(.cobj).KeyDown(*ink)
            EndIf
      End With
End Sub

Sub _gui_.delete_obj(objn As Integer)
      With This
            Clear(.o(objn),0,Len(_gui_obj_))
            For n As Integer = objn To .count-1
                  Swap .o(n), .o(n+1)
            Next
            .count-=1
            If .cobj > this.count Then .cobj = .count
      End With
End Sub

Sub _gui_.init_objs()
      For n As Integer = 1 To this.count
            With This
                  .o(n).Init_Self()
                  '' Resize based on scale
                  .o(n).w *= default_gui_scale
                  .o(n).h *= default_gui_scale
                  .o(n).x *= default_gui_scale
                  .o(n).y *= default_gui_scale
                  .o(n).cscale *= default_gui_scale
                  .o(n).cs *= default_gui_scale
                  .o(n).ls *= default_gui_scale
            End With
      Next
End Sub

Sub _gui_.draw_objs()
      Dim As Integer hasFocus=FALSE
      For objn As Integer = 1 To this.count
            If @this = @guiSet(c_gui) AndAlso objn = this.cobj Then hasFocus = TRUE Else hasFocus = FALSE
            this.o(this.obj_at_ord(objn)).Draw_Self(hasFocus)
      Next
End Sub

Sub _gui_.sort_objs()

      With This
     
      '' Give each object a unique order.
      For objn As Integer = 1 To .count
            .o(objn).ord = objn
      Next
     
      If .count <= 1 Then Exit Sub

      Dim As Integer swapped,looptimes

      Do
            looptimes+=1
            swapped=FALSE
            For n1 As Integer = 1 To .count
                  For n2 As Integer = 1 To .count
                        If n1 <> n2 Then
                              If .compare_objs(n1, n2) Then
                                    Swap .o(n1).ord, .o(n2).ord
                                    swapped=TRUE
                              End If
                        EndIf
                  Next
            Next
      Loop Until swapped = FALSE Or looptimes > .count*2
     
      If looptimes > .count*2 Then
            Beep '' Stuck in sort cycle.
            db_write("Stuck in guiObjs sorting cycle.")
            _Quit()
      EndIf
     
      End With
     
End Sub

Function _gui_.compare_objs(objn1 As Integer, objn2 As Integer) As Integer

      With This
     
      If .o(objn1).ord > .o(objn2).ord Then
     
            '' Forms go behind everything:
            If .o(objn1).kind = guiObjKind.Form AndAlso .o(objn2).kind <> guiObjKind.Form Then
                  Return TRUE
                 
            '' Forced Layering by .z :
            ElseIf .o(objn1).z < .o(objn2).z Then
                  Return TRUE
                 
            EndIf
           
      EndIf
     
      End With
     
      Return FALSE

End Function

Sub _gui_.reset_objs()
      For objn As Integer = 1 To this.count
            this.o(objn).Reset_Self()
      Next
End Sub

Function _gui_.obj_at_ord(at_ord As Integer) As Integer
      For objn As Integer = 1 To this.count
            If this.o(objn).ord = at_ord Then Return objn
      Next
End Function

Function _gui_.obj_at_xy(x As Integer, y As Integer) As Integer

      '' Check if a point is within any gui-object(s). Return foremost if multiple:
      Dim As Integer HighestOrderObj
      For n As Integer = 1 To this.count
            With this.o(n)
                  If PointInBox(x,y,.x,.y-.z,.x+.w-1,.y+.h-1-.z) Then
                        If HighestOrderObj = 0 Then
                              HighestOrderObj = n
                        Else
                              If .ord > this.o(HighestOrderObj).ord Then HighestOrderObj = n
                        EndIf
                  EndIf
            End With
      Next
      Return HighestOrderObj
     
End Function

Sub _gui_.move_par(parID As ZString Ptr, x As Integer, y As Integer)
      With This
            Dim As Integer par = .obj_with_id(*parID)
            For n As Integer = 1 To .count
                  If .o(n).par = par Then
                        Dim As Integer offx = .o(n).x - .o(par).x
                        Dim As Integer offy = .o(n).y - .o(par).y
                        .o(n).x = x + offx
                        .o(n).y = y + offy
                  EndIf
            Next
            .o(par).x = x
            .o(par).y = y
      End With
End Sub

Function _gui_.obj_with_id(id As ZString Ptr) As Integer
      If Len(Trim(*id)) = 0 Then Return -1
      For objn As Integer = 1 To this.count
            If Trim(this.o(objn).id) = Trim(*id) Then Return objn
      Next
      _Quit("No GUI object found with ID: " & *id, TRUE)
      Return 0
End Function

Sub _gui_.load_objs(f As ZString Ptr)
      With This
     
      .closeGUI()
     
     
      Dim As Integer ff = FreeFile
      If doesExist(ExePath & "\data\"+Trim(*f)) = FALSE Then
            Beep
            db_write(ExePath & "\data\"+Trim(*f)+" does not exist, when loading a guiObj file.")
            Exit Sub
      EndIf
      Open Trim(ExePath & "\data\"+Trim(*f)) For Binary Access Read As #ff
      Get #ff,,.count
      For objn As Integer = 1 To .count
            Get #ff,,.o(objn).id
            Get #ff,,.o(objn).kind
            Get #ff,,.o(objn).x
            Get #ff,,.o(objn).y
            Get #ff,,.o(objn).z
            Get #ff,,.o(objn).w
            Get #ff,,.o(objn).h
            Get #ff,,.o(objn).c1
            Get #ff,,.o(objn).c2
            Get #ff,,.o(objn).c3
            Get #ff,,.o(objn).ct
            Get #ff,,.o(objn).font
            Get #ff,,.o(objn).cs2x
            Get #ff,,.o(objn).cscale
            Get #ff,,.o(objn).cs
            Get #ff,,.o(objn).ls
            Get #ff,,.o(objn).txt
            Get #ff,,.o(objn).border
            Get #ff,,.o(objn).visible
            Get #ff,,.o(objn).par
            If .o(objn).kind = guiObjKind.Form Then
            ElseIf .o(objn).kind = guiObjKind.Button Then
                  Get #ff,,.o(objn).btn.switch
                  Get #ff,,.o(objn).btn.d
            ElseIf .o(objn).kind = guiObjKind.Textbox Then
            ElseIf .o(objn).kind = guiObjKind.ListBox Then
                  Get #ff,,.o(objn).lst.c
                  Get #ff,,.o(objn).lst.s
                  For n2 As Integer = 1 To .o(objn).lst.c
                        Get #ff,,.o(objn).lst.txt(n2)
                  Next
            ElseIf .o(objn).kind = guiObjKind.CheckBox Then
                  Get #ff,,.o(objn).chk.vlu
            ElseIf .o(objn).kind = guiObjKind.InputBox Then
                  Get #ff,,.o(objn).inb.allow
                  Get #ff,,.o(objn).inb.cc
                  Get #ff,,.o(objn).inb.cl
            EndIf
      Next
      Close #ff
      End With
End Sub

Sub _gui_.closeGUI()
      With This
      For n As Integer = 1 To .count
            .delete_obj(n)
      Next
      End With
End Sub

Sub guiBox(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, clr As UInteger, border As Integer = 1, invert As Integer = FALSE)
      border-=1
      GL.box_filled(x1,y1,x2,y2,clr)
      If border > -1 Then
            If invert Then
                  GL.box_filled(x1,y1,x2-border,y1+border,RGBA(0,0,0,100))
                  GL.box_filled(x1,y1,x1+border,y2-border,RGBA(0,0,0,100))
                  GL.box_filled(x2-border,y1+border,x2,y2-border,RGBA(255,255,255,70))
                  GL.box_filled(x1+border,y2-border,x2,y2,RGBA(255,255,255,70))
            Else
                  GL.box_filled(x1,y1,x2-border,y1+border,RGBA(255,255,255,70))
                  GL.box_filled(x1,y1,x1+border,y2-border,RGBA(255,255,255,70))
                  GL.box_filled(x2-border,y1+border,x2,y2-border,RGBA(0,0,0,100))
                  GL.box_filled(x1+border,y2-border,x2,y2,RGBA(0,0,0,100))
            EndIf
      EndIf
End Sub

Sub guiWin(x As Integer = -9999, y As Integer = -9999, w As Integer, h As Integer, clrInside As UInteger, border As Integer = 2, clrBorder As UInteger = _Black, expand As Integer = TRUE)
      If x = -9999 Then x = SCR_W\2
      If y = -9999 Then y = SCR_H\2
      Dim As Integer sx,sy,gx,gy
      sx = x+w\2
      sy = y+h\2
      If expand Then
            Do
                  __ProxyRefresh()
                  gx += 5
                  gy += 5
                  If gx > w\2 Then gx=w\2
                  If gy > h\2 Then gy=h\2
                  GL.box_filled(sx-gx,sy-gy,sx+gx,sy+gy,clrBorder)
                  GL.box_filled(sx-gx+(border),sy-gy+(border),sx+gx-(border),sy+gy-(border),clrInside)
                  __ProxyFlip()
            Loop Until gx=w\2 And gy=h\2
      Else
            GL.box_filled(sx-w\2,sy-h\2,sx+w\2,sy+h\2,clrBorder)
            GL.box_filled(sx-w\2+(border),sy-h\2+(border),sx+w\2-(border),sy+h\2-(border),clrInside)
      End If
End Sub

Sub MsgBox (txt As String,      font As Integer=6, charlim As Integer=24, _
                        clrInside As UInteger=RGB(202,146,117),      clrBorder As uInteger=RGB(161,102,105),      border As Integer=2)
                       
      '' Msgbox with default positioning. Done to avoid use of empty commas when calling.
      MsgBox(-1,-1,txt,font,charlim,clrInside,clrBorder,border)
     
End Sub


Sub MsgBox (x As Integer,      y As Integer,      txt As String,      font As Integer=6,      charlim As Integer=24, _
                        clrInside As UInteger=RGB(202,146,117),      clrBorder As uInteger=RGB(161,102,105),      border As Integer=2)

      '' Error-catching:
      If font*96-95 > UBound(font_spr) Then db_write("Font " + Str(font) + " doesn't exist in memory.") : Beep : Exit Sub

      '' Get the line count from parse:
      Dim As Integer lin_count
     
      lin_count = GUI.text(0,0,txt,,,charlim,,,,TRUE)
     
      '' Get the font's char width and height as the default spacing:
      Dim As Integer char_w = font_spr(font*96-95).p->Width * default_font_scale
      Dim As Integer linesp = font_spr(font*96-95).p->Height * default_font_scale
     
      '' Calc Msgbox size and position:
      Dim As Integer w = IIf(len(txt)       Dim As Integer h = lin_count * linesp + border * 2 + 4
      If x = -1 Then x = SCR_W\2 - w\2
      If y = -1 Then y = SCR_H\2 - h\2

      Dim As Integer pMb

      Dim As String ink
      Do
            ink = InKey
            __ProxyRefresh()
           
            guiWin(x,y,w,h,clrInside,border,clrBorder,FALSE)
            'text(x+border+1,y-8,title)

            GUI.text(x+border+2, y+border+2, txt, _White, font, charlim, 0, linesp, default_font_scale)
           
            __ProxyFlip()
           
      Loop Until Asc(Left(ink,1)) = 13

End Sub

Function guiInptBox(title As String, default As ZString Ptr = 0) As String
      '' A quick input box with a title and place to enter some characters.
      #Define charLimit 36
      Dim As Integer w = charLimit*7+14
      Dim As Integer h = 40
      guiWin(scr_w\2-w\2,scr_h\2-h\2,w,h,RGB(50,50,60),2,_White,TRUE)
      Dim As ZString * 3 ink
      Dim As ZString * charLimit+1 InTxt = Space(charLimit)      '' charLimit +1 for null character attachment to ZString
      If Len(Trim(*default)) Then InTxt = RTrim(*default) + Space(charLimit-Len(RTrim(*default)))      '' Spaces have to be filled in or there's a problem.
      Dim As Integer txtx=Len(RTrim(*default))+1
      Dim As Double prevTime=Timer, BlinkTmr=Timer
      Do
            prevTime = Timer
            ink = Inkey
            If Len(ink) Then
                  Select Case Asc(Left(ink,1))
                  Case 255
                        If Asc(Right(ink,1)) = 75 Then txtx -= 1
                        If Asc(Right(ink,1)) = 77 Then txtx += 1
                  Case 8
                             txtx -= 1
                        Mid(InTxt,txtx,1) = " "
                  Case 32 To 126
                        If txtx <= charLimit Then                              '' Stop input if reached char limit.
                              Mid(InTxt,txtx,1) = Left(ink,1)
                        EndIf
                        txtx+=1
                  Case 27: InTxt = Space(charLimit): Exit Do
                  Case 13: Exit Do
                  End Select
                  If txtx < 1 Then txtx = 1
                  If txtx > charLimit+1 Then txtx = charLimit+1      '' Allow input line to go in front of last character.
            EndIf
            __ProxyRefresh()
            guiWin(scr_w\2-w\2,scr_h\2-h\2,w,h,RGB(50,50,60),2,_White,FALSE)
            GL.box_filled( scr_w\2 -w\2 +4, scr_h\2 , scr_w\2 +w\2 -4, scr_h\2 +16, RGBA(230,230,230,255) )
            text(SCR_w\2-(Len(RTrim(title))*7)\2,SCR_h\2 -h\2 +8,title,_White)
            text(SCR_w\2 -w\2 +5, SCR_h\2+6,RTrim(InTxt),_Black2)
            If Timer-BlinkTmr>.3 Then GL.box_filled(SCR_w\2 -w\2 +4 +txtx*7-7, SCR_h\2 +2, SCR_w\2 -w\2 +5 +txtx*7-7, SCR_h\2 +14,_Black2)
            If Timer-BlinkTmr> .6 Then BlinkTmr = Timer
            __ProxyFlip()
      Loop
      Return Trim(InTxt)
End Function

Constructor optBox_
      x                        = cam_x1
      y                        = cam_y1
      corner_at_xy      = 0
      border                  = 2
      font                  = 3
      clrBorder            = RGB(65,60,85)
      clrInside            = RGB(105,100,125)
      clrText                  = RGB(255,255,255)
      expand                  = TRUE
End Constructor

Sub OptnBox_setup(oBox As optBox_)
      With oBox
            '' Error-catching:
            If .font*96-95 > UBound(font_spr) Then db_write("Font " + Str(.font) + " doesn't exist in memory.") : Beep : Exit Sub

            '' Get the font's char width and height as the optBox charsp and linesp:
            '.charsp = font_spr(.font*96-95).p->Width * default_font_scale
            .linesp = font_spr(.font*96-95).p->Height * default_font_scale

            '' Calculate size of box by checking content:
            Dim As Integer wid, most_wid, emptyCount, char
           
            For cx As Integer = 1 To Len(.title)
                  char = Asc(Mid(.title,cx,1))
                  wid += font_spr((.font*96-96)+char-31).p->Width
            Next
           
            most_wid = wid
            For n As Integer = 1 To UBound(.optn)
                  wid = 0
                  If Len(RTrim(.optn(n))) Then
                        .count += 1
                        For cx As Integer = 1 To Len(.optn(n))
                              char = Asc(Mid(.optn(n),cx,1))
                              wid += font_spr((.font*96-96)+char-31).p->Width
                        Next
                        If emptyCount Then
                              .count += emptyCount
                              emptyCount = 0
                        EndIf
                  Else
                        emptyCount += 1
                  EndIf
                  If wid > most_wid Then most_wid = wid
            Next
           
            .w = most_wid + .border*2
            .h = .linesp * (.count + 2) + .border*2
           
            If .corner_at_xy = 0 Then            '' Centered at x/y
                  .x -= .w\2
                  .y -= .h\2
            ElseIf .corner_at_xy = 2 Then
                  .x -= .w
            ElseIf .corner_at_xy = 3 Then
                  .x -= .w
                  .y -= .h
            ElseIf .corner_at_xy = 4 Then
                  .y -= .h
            EndIf
      End With
End Sub

Function OptnBox(title As ZString Ptr,_
                        o1 As ZString Ptr = 0, o2 As ZString Ptr = 0, o3 As ZString Ptr = 0, o4 As ZString Ptr = 0, _
                        o5 As ZString Ptr = 0, o6 As ZString Ptr = 0, o7 As ZString Ptr = 0, o8 As ZString Ptr = 0) As Integer
      '' A quicker-to-use version of the OptnBox
      Dim newOptBox As optBox_
      With newOptBox
            .x = scr_w\2
            .y = scr_h\2
            .title = *title
            .optn(1) = *o1 : .optn(2) = *o2 : .optn(3) = *o3 : .optn(4) = *o4
            .optn(5) = *o5 : .optn(6) = *o6 : .optn(7) = *o7 : .optn(8) = *o8
      End With
      Return OptnBox(newOptBox)
End Function

Function OptnBox(oBox As optBox_) As Integer
      Dim As Double prevTime

      With oBox
     
            OptnBox_setup(oBox)
           
            guiWin(.x,.y,.w,.h,.clrInside,.border,.clrBorder,.expand)
           
            Do
                  __ProxyRefresh()
                 
                  .c_opt=0
                  If Inkey = Chr(27) Then Exit Do
                 
                  guiWin(.x,.y,.w,.h,.clrInside,.border,.clrBorder,FALSE)
                  text(.x+2+.border,.y+2+.border,.title,_White,.font,,.charsp,.linesp)
                  For n As Integer = 1 To UBound(.optn)
                        If Len(.optn(n)) Then
                              text(.x+3+.border,.y+4+.border+(n*.linesp),.optn(n),_White,.font,,.charsp,.linesp)
                              'GL.box(.x+.border, .y+4+.border+n*.linesp, .x+.border+.w-.border*2, .y+4+.border+n*.linesp+.linesp,_White)
                              If PointInBox(mx,my, .x+.border, .y+4+.border+n*.linesp, .w-.border*2, .linesp, TRUE) Then
                                    text(.x,.y+4+.border+(n*.linesp),">",_Green,3,,.charsp,20)
                                    .c_opt = n
                              End If
                        End If
                  Next
                  __ProxyFlip()
            Loop Until prvmb=1 AndAlso mb=0 AndAlso .c_opt
     
      End With
     
      prvmb = 0                  '' Stops unwanted actions after leaving.
      Return oBox.c_opt

End Function

Sub eText(x As Integer, y As Integer, txt As String, clr As UInteger = _White, font As Integer = 3, scale As Single = default_font_scale, align As Integer = Align_L, vAlign As Integer = vAlign_T)
      '' Editor text, for simplifying the down-scaling (removing ,,3,,,,.25 everywhere.)
      text(x,y,txt,clr,font,,,,scale, align)
End Sub

Function text(x As Integer, y As Integer, txt As String, clr As UInteger = _White, font As Integer = 6, charlim As Integer=MaxCharLimit, charsp As Integer=0, linesp As Integer=0, scale As Single = default_font_scale, align As Integer = Align_L, vAlign As Integer = vAlign_T, LineCountOnly As Integer = FALSE) As Integer

      '' Parse text into lines based on character limit:
     
      Dim As String * MaxCharLimit lin(1 To MaxLineLimit)
      Dim As Integer c_lin, c_lin_cx, lin_count, txt_cx, last_sp
      Dim As String * 1 char
     
      c_lin = 1
      lin_count = 1
      Do
            txt_cx += 1
            If txt_cx > Len(txt) Then Exit do
            char = Mid(txt,txt_cx,1)
            c_lin_cx += 1
           
            '' Check for needed line break:
            If char = " " Then last_sp = c_lin_cx
            If c_lin_cx = charlim Then                  '' Reached character limit of a single line
                  Mid(lin(c_lin), last_sp+1, c_lin_cx - last_sp ) = Space(c_lin_cx - last_sp) '' Erase word that runs over the limit
                  txt_cx -= (c_lin_cx - last_sp -1)      '' Reset reading position to last found space + 1
                  char = Mid(txt,txt_cx,1)
                  'db_write(lin(c_lin))
                  c_lin += 1 : lin_count += 1
                  If c_lin > MaxLineLimit Then Beep : db_write("Went over text line limit.") : _Quit()
                  c_lin_cx = 1
            EndIf
           
            Mid(lin(c_lin),c_lin_cx,1) = char
           
      Loop

      If LineCountOnly = TRUE Then Return lin_count
     
      '' Error-catching:
      If font*96-95 > UBound(font_spr) Then db_write("Font " + Str(font) + " doesn't exist in memory.") : Beep : Exit Function
     
      '' Get the font's char width and height as the default spacing:
      'If charsp = 0 Then charsp = font_spr(font*96-95).p->Width * scale
      If linesp = 0 Then linesp = font_spr(font*96-95).p->Height * scale

      Dim As Integer xx, yy
      Dim As Integer first_char_w = font_spr((font*96-96)+1).p->Width            ''Alignments currently only look right if all character w & h are equal.
      Dim As Integer first_char_h = font_spr((font*96-96)+1).p->Height
      Dim As UInteger ch

      For l As Integer = 1 To lin_count
            If align = align_c Then x-=(first_char_w + charsp) * scale * Len(Trim(lin(l))) \ 2
            If vAlign = vAlign_c Then y-=first_char_h * scale \ 2
            For c As Integer = 1 To Len(Trim(lin(l)))
                  ch = Asc(Mid(lin(l),c,1))
                  If ch-31 > 96 Or ch-31 < 1 Then
                        db_write("Character: "+Str(ch)+" not found in font.") : Beep
                  Else      '' Draw the character:
                        glColor4ub(RGBA_R(clr),RGBA_G(clr),RGBA_B(clr),RGBA_A(clr))
                        GL.sprite_scale(x+xx,y+yy,scale,font_spr((font*96-96)+ch-31).p)
                        xx+=(font_spr((font*96-96)+ch-31).p->Width + charsp) * scale
                  EndIf
            Next
            xx = 0
            yy += linesp
      Next

      glColor4ub(255,255,255,255)
      Return lin_count
End Function

Sub WaitForNoMouseBtn()
      While mb<>0
            __ProxyRefresh()
            __ProxyFlip()
            Sleep(15,1)
      Wend
End Sub

Sub WaitForThisKey(waitkey As ZString Ptr)
      Dim As ZString * 3 ink
      Do
            ink = Inkey
            __ProxyRefresh()
            __ProxyFlip()
            Sleep(15,1)
      Loop Until ink = *waitkey
End Sub

Function GetInkey() As String
      Dim As ZString*3 ink
      Do
            ink = InKey
            __ProxyRefresh()
            __ProxyFlip()
            Sleep(1)
      Loop Until Len(ink)
      Return ink
End Function

Sub WaitTime(t As Double)
      Dim As Double wStartTime = Timer
      Do
            __ProxyRefresh()
            __ProxyFlip()
            Sleep(1,1)
      Loop Until Timer - wStartTime >= t
End Sub

Function interface_files(filter As String = "*.*", title As String = "Files") As String
      Dim As Integer w,h,n
      Dim As String f
     
      c_gui = gui_available()
      If c_gui = 0 Then Exit Function

      With guiSet(c_gui)
      .load_objs("frmdirectory.dat")
      .init_objs()

     
      .cobj = .obj_with_id("inbFilename")
     
      SetMouse ,,0
     
      Do
            .reset_objs()
           
            Dim As Integer pmb = mb '' Previous mouse button
            GetMouse(mx,my,,mb)

            Dim As String ink = Inkey
            If Len(ink) Then
                  If .cobj Then .o(.cobj).KeyDown(ink)
                  If ink=Chr(13) Then
                        If .cobj = .obj_with_id("inbFilename") Then
                              f = Trim(.o(.obj_with_id("inbFilename")).txt)
                              If Left(f,3) = "cd " Then
                                    Dim result As Integer = ChDir(Right(f,Len(f)-3))
                                    If 0 <> result Then
                                          Beep
                                    EndIf
                                    .o(.obj_with_id("inbFilename")).Init_Self()
                              ElseIf Left(f,2) = "*." Then
                                    filter = Left(f,5)
                                    .o(.obj_with_id("inbFilename")).Init_Self()
                              ElseIf Len(f) = 0 Then
                                    Beep
                              Else
                                    Function = CurDir+"\"+f
                                    Exit Do
                              End If
                        EndIf
                  EndIf
                  If ink = KB_ESC Then Exit Do
            EndIf
           
            If mb = 0 Then
                  If pMb = 0 Then
                        grabbed = FALSE
                  ElseIf pMb = 1 Then '' Clicked and lifted mouse button
           
                        .cobj = .obj_at_xy(mx,my)
                        If .cobj Then
                              .o(.cobj).MouseUp(pMb)
                       
                              Select Case Trim(.o(.cobj).id)
                              Case "cmdLoad"
                                    f = Trim(.o(.obj_with_id("inbFilename")).txt)
                                    If Len(f) = 0 Then
                                          Beep
                                    else
                                          Function = CurDir+"\"+f
                                          Exit Do
                                    EndIf
                              Case "cmdCancel"
                                    Function = ""
                                    Exit Do
                              End Select
                        EndIf
                       
                  EndIf
                 
            ElseIf mb = 1 Then
                  .cobj = .obj_at_xy(mx,my)
                  If .cobj Then
                        .o(.cobj).MouseDown(mx,my,mb,pmb)
                        If pMb = 0 Then
                        EndIf
                  EndIf

            End If

            'If MultiKey(SC_Escape) Then Exit Do

            GL.box_filled(0,0,SCR_W-1,SCR_H-1,RGBA(100,100,100,255))
            GL.Print(10,10,title+" :: "+ CurDir + " ("+filter+")")
            GL.Print(10,20,"To change directory, type cd . To filter a type of file, use *.")
            'list_files("*", fbDirectory Or fbHidden, 2, 8) '&h37
            'list_files(filter, fbArchive, 2, 15, 32)
           
            Dim filename As String
            Dim As Integer x, y, breaks, break_y, margin_left, margin_top, char_limit
           
            margin_left = 10
            margin_top = 40
            break_y = 200
            char_limit = 16
            x = margin_left
            y = margin_top
           
            filename = Dir( "*.*", fbDirectory Or fbHidden )
            Do
                  If filename <> "." And filename <> ".." Then
                        GL.Print(x,y,Left(filename,char_limit))            '' Limit filename length
                        y+=10
                        If break_y And y > break_y Then
                              breaks +=1
                              y = margin_top
                              x = margin_left+((char_limit*10)*breaks)
                        End If
                  End If
                  filename = Dir( )
            Loop While Len( filename ) > 0
           
           
            margin_left = 10
            margin_top = 220
            break_y = 800
            char_limit = 16
            x = margin_left
            y = margin_top
           
            filename = Dir( filter, fbArchive )
            Do
                  If filename <> "." And filename <> ".." Then
                        GL.Print(x,y,Left(filename,char_limit))            '' Limit filename length
                        y+=10
                        If break_y And y > break_y Then
                              breaks +=1
                              y = margin_top
                              x = margin_left+((char_limit*10)*breaks)
                        End If
                  End If
                  filename = Dir( )
            Loop While Len( filename ) > 0
           
            .sort_objs()
            .draw_objs()
           
            GL.sprite(mx,my,gui_spr(1).p)
            __ProxyFlip()
      Loop
     
      End With
     
      guiSet(c_gui).closeGUI()
     
End Function

End Namespace


<- back