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 = 309, 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, selected_button As Byte = 0) 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 As UByte page
 112         page = selected_button \ 4
 113         selected_button = selected_button Mod 4 + 1
 114         Dim maxpage As UByte = (UBound(options)) \ 4 + 1
 115         Do
 116                 resizewindow(310, 300, title) 'resize or cls
 117                 drawbutton(title,,0,,False)
 118
 119                 'write out 4 options
 120                 Dim As Byte row = 1, fn = page * 4
 121                 Do While row <= 4 And fn <= UBound(options)
 122                         buttons(row) = drawbutton(row & ". " + options(fn), Str(row), row,,,row = selected_button)
 123                         row += 1 : fn += 1
 124                 Loop
 125
 126                 buttons(5) = drawbutton("prev", "p", 5, 0)
 127                 buttons(6) = drawbutton("next", "n", 5, 1)
 128                 drawbutton(page + 1 & "/" & maxpage, , 5, 2, False)
 129                 buttons(0) = drawbutton("exit", "x", 5, 3)
 130                 'wait for key or click
 131                 Do
 132                         keypress = InKey
 133                         If keypress = "" Then keypress = menumouse(buttons())
 134                 Loop Until keypress <> ""
 135                 'prev/next page
 136                 Select Case keypress
 137                         Case Chr(255)+"P"
 138                                 selected_button += 1
 139                                 If selected_button > row - 1 Then selected_button = 1
 140                         Case Chr(255)+"M", "n" 'down or right or n
 141                                 page = (page + 1) Mod maxpage
 142                                 selected_button = 1
 143                         Case Chr(255)+"H"
 144                                 selected_button -= 1
 145                                 If selected_button < 1 Then selected_button = row - 1
 146                         Case Chr(255)+"K" , "p"  'up or left or p
 147                                 page = (page - 1 + maxpage) Mod maxpage
 148                                 selected_button = 1
 149                         Case Chr(13) 'Enter
 150                                 If selected_button > 0 Then keypress = Str(selected_button)
 151                                 Exit Do
 152                         Case Else
 153                                 Exit Do
 154                 End Select
 155         Loop
 156         'return selected option + page*4 - 1
 157         If Val(keypress) >= 1 And Val(keypress) <= 4 And Len(options(Val(keypress) + page*4 - 1)) Then Return Val(keypress) + page*4 - 1
 158         Return -1
 159 End Function
 160
 161
 162 Function onoff(what As Byte) As String
 163         If what Then Return ": on"
 164         Return ": off"
 165 End Function
 166
 167
 168 Sub opentilesettings()
 169
 170 End Sub
 171
 172
 173 Sub opensettings()
 174         Dim selected As Byte = 0
 175         Dim title As String = "Settings"
 176         Dim options(5) As String
 177         Do
 178                 options(0) = "Show shadow" + onoff(settings.show_shadow)
 179                 options(1) = "Show speed" + onoff(settings.show_speed)
 180                 options(2) = "Show score" + onoff(settings.show_score)
 181                 options(3) = "Play with mouse" + onoff(settings.play_mouse)
 182                 options(4) = "1st button turning" + onoff(settings.first_button_turning)
 183                 options(5) = "Curent tileset: " + tilesfiles(settings.tileset)
 184                 selected = drawmenu(title, options(), selected)
 185                 Select Case selected
 186                         Case 0
 187                                 settings.show_shadow = Not settings.show_shadow
 188                         Case 1
 189                                 settings.show_speed = Not settings.show_speed
 190                         Case 2
 191                                 settings.show_score = Not settings.show_score
 192                         Case 3
 193                                 settings.play_mouse = Not settings.play_mouse
 194                         Case 4
 195                                 settings.first_button_turning = Not settings.first_button_turning
 196                         Case 5
 197                                 loadTiles(drawmenu("Select tileset", tilesfiles(), settings.tileset))
 198                                 Exit Do
 199                         Case -1
 200                                 Exit Do
 201                 End Select
 202         Loop
 203 End Sub
 204
 205
 206 Function openloader(directory As String) As String
 207         Dim title As String = "Load Variation"
 208         'store all filenames
 209         ReDim filenames (0) As String
 210         filenames(0) = Dir(directory + "/*")
 211         Do While Len(filenames(UBound(filenames)))
 212                 ReDim Preserve filenames(UBound(filenames) + 1)
 213                 filenames(UBound(filenames)) = Dir()
 214         Loop
 215         ReDim Preserve filenames(UBound(filenames) - 1) 'last one was empty
 216         'extract titles
 217         Dim titles(UBound(filenames)) As String
 218         Dim As Byte row = 1, fn = 0
 219         Do While fn <= UBound(filenames)
 220                 titles(fn) = readtitle(directory + "/" + filenames(fn))
 221                 fn += 1
 222         Loop
 223         'draw menu and return a variation (if any)
 224         fn = drawmenu(title, titles())
 225         If fn > -1 Then Return directory + "/" + filenames(fn)
 226 End Function
 227
 228
 229 Sub openhelp()
 230         resizewindow(310,300, "Help")
 231
 232         Color RGB(127,127,127)
 233         Print "Generic Block Game"
 234         Print
 235         Print "This game is free software (GPL3+)."
 236         Print "See fbc.bas for source and details."
 237         Print
 238         Color RGB(255,255,255)
 239         If gravity Then
 240                 Print "Use left and right arrows to move,"
 241                 Print "Up arrow or space to rotate"
 242                 Print "Down arrow to lower, Enter to drop,"
 243         Else
 244                 Print "Use arrows to move,"
 245                 Print "Space to rotate, Enter to fix,"
 246         End If
 247         Print
 248         Print "F1 for help, T to change tileset,"
 249         Print "S to toggle score, O for options,"
 250         Print "+ to increase speed, ESC for menu"
 251         Print
 252         Color RGB(127,127,127)
 253         Print "Help for " + game.title
 254         Color RGB(255,255,255)
 255         Print
 256
 257         Dim As UByte a
 258         For a = 0 To UBound(help)
 259                 Print help(a)
 260         Next a
 261
 262         Dim e As EVENT
 263         Do
 264                 keypress=InKey
 265                 ScreenEvent(@e)
 266                 Sleep 25
 267         Loop Until keypress <> "" Or e.type = EVENT_MOUSE_BUTTON_PRESS
 268
 269         resizewindow()
 270         drawplayfield()
 271 End Sub
 272
 273
 274 Sub openmenu()
 275         Dim selected As Byte = 0
 276         Dim title As String = "Menu"
 277         Dim options(4) As String
 278         Do
 279                 options(0) = "Show help"
 280                 options(1) = "Restart game"
 281                 options(2) = "Load game"
 282                 options(3) = "Quit game"
 283                 options(4) = "Settings"
 284                 selected = drawmenu(title, options(), selected)
 285                 Select Case selected
 286                         Case 0
 287                                 openhelp()
 288                                 Exit Sub
 289                         Case 1
 290                                 gameRestart()
 291                                 Exit Do
 292                         Case 2
 293                                 If loadgame(openloader(VARPATH)) Then Exit Sub 'Don't restore window size
 294                         Case 3
 295                                 quit()
 296                         Case 4
 297                                 opensettings()
 298                         Case -1
 299                                 Exit Do
 300                 End Select
 301                 Sleep 25
 302         Loop
 303         resizewindow()
 304         drawplayfield()
 305 End Sub