menus.bi

   1 /'
   2 This file is part of Generic Block Game
   3
   4 Generic Block Game is free software: you can redistribute it and/or modify
   5 it under the terms of the GNU General Public License as published by
   6 the Free Software Foundation, either version 3 of the License, or
   7 (at your option) any later version.
   8
   9 Generic Block Game is distributed in the hope that it will be useful,
  10 but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 GNU General Public License for more details.
  13
  14 You should have received a copy of the GNU General Public License
  15 along with this program.  If not, see <https://www.gnu.org/licenses/>.
  16 '/
  17
  18 Type button
  19         text As String * 64
  20         As Byte row, column, border
  21         As UShort x, y, w, h
  22         keypress As String * 2
  23 End Type
  24
  25
  26 Type buttonset
  27         As button n(6)
  28 End Type
  29
  30
  31 Function isin(xx As Short,yy As Short,x As Short,y As Short,w As UShort=50,h As UShort=50) As Byte
  32                 Dim in As Byte = True
  33                 in=in And xx>=x And xx<=x+w
  34                 in=in And yy>=y And yy<=y+h
  35                 Return in
  36 End Function
  37
  38
  39
  40 Function readtitle(filename As String) As String
  41         Dim As String l, result
  42         Open filename For Input As #1
  43         If Err>0 Then Print "Error opening the file":End
  44         Do
  45                 Line Input #1,l
  46                 Select Case l
  47                         Case "Title {"
  48                                 Line Input #1,result
  49                 End Select
  50         Loop Until Eof(1)
  51         Close #1
  52         Return result
  53 End Function
  54
  55
  56 Function drawbutton(text As String, keypress As String = "", row As Byte, column As Byte = -1, border As Byte = True, filled As Byte = False) As button
  57 'Draws a button. If column (0 to 4) is present, draws a smaller button in that column
  58         Const MAXW = 299, H = 40, MARGIN = 10, PL = 20, FH = 8, FW = 8
  59         Dim as Short w = MAXW, ox = 0
  60         If column >= 0 Then
  61                 w = MAXW / 4 - MARGIN * 0.75
  62                 ox = (w + MARGIN) * column
  63         End If
  64         If filled Then
  65                 Line (ox, H*row + MARGIN*row)-(ox + w, H*row+MARGIN*row+H), RGB(0,0,127), bf
  66         Else
  67                 Line (ox, H*row + MARGIN*row)-(ox + w, H*row+MARGIN*row+H), RGB(11,11,11), bf
  68         End If
  69         If border Then Line (ox, H*row + MARGIN*row)-(ox + w, H*row+MARGIN*row+H), RGB(127,127,127), b
  70         If (Not border) Or (column >= 0) Then
  71                 Draw String (ox + w/2-Len(text)*FW/2, H*row+MARGIN*row + H/2-FH/2), text
  72         Else
  73                 Draw String (ox + PL, H*row+MARGIN*row + H/2-FH/2), text
  74         End If
  75         Return Type(text, row, column, border, ox, H*row + MARGIN*row, w, H, keypress)
  76 End Function
  77
  78
  79 Function menumouse(buttons() As button) As String
  80         Dim e As EVENT
  81         Dim As Integer mousex, mousey, pressed
  82
  83         If (ScreenEvent(@e)) Then
  84                 Select Case e.type
  85                 Case EVENT_MOUSE_BUTTON_PRESS
  86                         pressed = e.button=1
  87                                 If e.button=2 Then Return Chr(27)
  88                                 If pressed Then
  89                                         GetMouse(mousex,mousey)
  90                                         Dim a as UByte
  91                                         For a = 0 to UBound(buttons)
  92                                                 If isin(mousex,mousey,buttons(a).x, buttons(a).y,buttons(a).w,buttons(a).h) Then Return buttons(a).keypress
  93                                         Next
  94                                 End If
  95                 Case EVENT_MOUSE_BUTTON_RELEASE
  96                         pressed = 0
  97                 Case EVENT_MOUSE_MOVE
  98                         If (pressed) Then
  99                                 ScreenControl GET_WINDOW_POS, mousex, mousey
 100                                 ScreenControl SET_WINDOW_POS, mousex + e.dx, mousey + e.dy
 101                         End If
 102                 End Select
 103         End If
 104 End Function
 105
 106
 107 Function drawmenu(title As String, options() As String) As Byte
 108         'Draws a menu with 4 options from options array
 109         Dim keypress As String
 110         Dim buttons(6) As button
 111         Dim selected_button As Byte = 0
 112         Dim As UByte page = 0
 113         Dim maxpage As UByte = (UBound(options)) \ 4 + 1
 114         Do
 115                 resizewindow(300, 300, title) 'resize or cls
 116                 drawbutton(title,,0,,False)
 117
 118                 'write out 4 options
 119                 Dim As Byte row = 1, fn = page * 4
 120                 Do While row <= 4 And fn <= UBound(options)
 121                         buttons(row) = drawbutton(row & ". " + options(fn), Str(row), row,,,row = selected_button)
 122                         row += 1 : fn += 1
 123                 Loop
 124
 125                 buttons(5) = drawbutton("prev", "p", 5, 0)
 126                 buttons(6) = drawbutton("next", "n", 5, 1)
 127                 drawbutton(page + 1 & "/" & maxpage, , 5, 2, False)
 128                 buttons(0) = drawbutton("exit", "x", 5, 3)
 129                 'wait for key or click
 130                 Do
 131                         keypress = InKey
 132                         If keypress = "" Then keypress = menumouse(buttons())
 133                 Loop Until keypress <> ""
 134                 'prev/next page
 135                 Select Case keypress
 136                         Case Chr(255)+"P"
 137                                 selected_button += 1
 138                                 If selected_button > row - 1 Then selected_button = 1
 139                         Case Chr(255)+"M", "n" 'down or right or n
 140                                 page = (page + 1) Mod maxpage
 141                         Case Chr(255)+"H"
 142                                 selected_button -= 1
 143                                 If selected_button < 1 Then selected_button = row - 1
 144                         Case Chr(255)+"K" , "p"  'up or left or p
 145                                 page = (page - 1 + maxpage) Mod maxpage
 146                         Case Chr(13) 'Enter
 147                                 If selected_button > 0 Then keypress = Str(selected_button)
 148                                 Exit Do
 149                         Case Else
 150                                 Exit Do
 151                 End Select
 152         Loop
 153         'return selected option + page*4 - 1
 154         If Val(keypress) >= 1 And Val(keypress) <= 4 And Len(options(Val(keypress) + page*4 - 1)) Then Return Val(keypress) + page*4 - 1
 155         Return -1
 156 End Function
 157
 158
 159 Function onoff(what As Byte) As String
 160         If what Then Return ": on"
 161         Return ": off"
 162 End Function
 163
 164
 165 Sub opensettings()
 166         Dim title As String = "Settings"
 167         Dim options(4) As String
 168         Do
 169                 options(0) = "Show shadow" + onoff(settings.show_shadow)
 170                 options(1) = "Show speed" + onoff(settings.show_speed)
 171                 options(2) = "Show score" + onoff(settings.show_score)
 172                 options(3) = "Play with mouse" + onoff(settings.play_mouse)
 173                 options(4) = "1st button turning" + onoff(settings.first_button_turning)
 174                 Select Case drawmenu(title, options())
 175                         Case 0
 176                                 settings.show_shadow = Not settings.show_shadow
 177                         Case 1
 178                                 settings.show_speed = Not settings.show_speed
 179                         Case 2
 180                                 settings.show_score = Not settings.show_score
 181                         Case 3
 182                                 settings.play_mouse = Not settings.play_mouse
 183                         Case 4
 184                                 settings.first_button_turning = Not settings.first_button_turning
 185                         Case -1
 186                                 Exit Do
 187                 End Select
 188         Loop
 189 End Sub
 190
 191
 192 Function openloader(directory As String) As String
 193         Dim title As String = "Load Variation"
 194         'store all filenames
 195         ReDim filenames (0) As String
 196         filenames(0) = Dir(directory + "/*")
 197         Do While Len(filenames(UBound(filenames)))
 198                 ReDim Preserve filenames(UBound(filenames) + 1)
 199                 filenames(UBound(filenames)) = Dir()
 200         Loop
 201         ReDim Preserve filenames(UBound(filenames) - 1) 'last one was empty
 202         'extract titles
 203         Dim titles(UBound(filenames)) As String
 204         Dim As Byte row = 1, fn = 0
 205         Do While fn <= UBound(filenames)
 206                 titles(fn) = readtitle(directory + "/" + filenames(fn))
 207                 fn += 1
 208         Loop
 209         'draw menu and return a variation (if any)
 210         fn = drawmenu(title, titles())
 211         If fn > -1 Then Return directory + "/" + filenames(fn)
 212 End Function
 213
 214
 215 Sub openhelp()
 216         resizewindow(300,300, "Help")
 217
 218         Color RGB(127,127,127)
 219         Print "Generic Block Game"
 220         Print
 221         Print "This game is free software (GPL3+)."
 222         Print "See fbc.bas for source and details."
 223         Print
 224         Color RGB(255,255,255)
 225         If gravity Then
 226                 Print "Use left and right arrows to move,"
 227                 Print "Up arrow or space to rotate"
 228                 Print "Down arrow to lower, Enter to drop,"
 229         Else
 230                 Print "Use arrows to move,"
 231                 Print "Space to rotate, Enter to fix,"
 232         End If
 233         Print
 234         Print "F1 for help, T to change tileset,"
 235         Print "S to toggle score, O for options,"
 236         Print "+ to increase speed, ESC for menu"
 237         Print
 238         Color RGB(127,127,127)
 239         Print "Help for " + game.title
 240         Color RGB(255,255,255)
 241         Print
 242
 243         Dim As UByte a
 244         For a = 0 To UBound(help)
 245                 Print help(a)
 246         Next a
 247
 248         Dim e As EVENT
 249         Do
 250                 keypress=InKey
 251                 ScreenEvent(@e)
 252         Loop Until keypress <> "" Or e.type = EVENT_MOUSE_BUTTON_PRESS
 253
 254         resizewindow()
 255         drawplayfield()
 256 End Sub
 257
 258
 259 Sub openmenu()
 260         Dim title As String = "Menu"
 261         Dim options(4) As String
 262         Do
 263                 options(0) = "Show help"
 264                 options(1) = "Restart game"
 265                 options(2) = "Load game"
 266                 options(3) = "Quit game"
 267                 options(4) = "Settings"
 268                 Select Case drawmenu(title, options())
 269                         Case 0
 270                                 openhelp()
 271                                 Exit Sub
 272                         Case 1
 273                                 gameRestart()
 274                                 Exit Do
 275                         Case 2
 276                                 If loadgame(openloader(VARPATH)) Then Exit Sub 'Don't restore window size
 277                         Case 3
 278                                 quit()
 279                         Case 4
 280                                 opensettings()
 281                         Case -1
 282                                 Exit Do
 283                 End Select
 284         Loop
 285         resizewindow()
 286         drawplayfield()
 287 End Sub