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, page As UByte Pointer) As String
 108         'Draws a menu with 4 options from options array
 109         Dim keypress As String
 110         Dim buttons(6) As button
 111         Dim newpage As Short = *page
 112         Dim maxpage As UByte = (UBound(options)) \ 4 + 1
 113         Do
 114                 resizewindow(300, 300, title) 'resize or cls
 115                 drawbutton(title,,0,,False)
 116
 117                 'write out 4 options
 118                 Dim As Byte row = 1, fn = *page * 4
 119                 Do While row <= 4 And fn <= UBound(options)
 120                         buttons(row) = drawbutton(row & ". " + options(fn), Str(row), row)
 121                         row += 1 : fn += 1
 122                 Loop
 123
 124                 buttons(5) = drawbutton("prev", "p", 5, 0)
 125                 buttons(6) = drawbutton("next", "n", 5, 1)
 126                 drawbutton(*page + 1 & "/" & maxpage, , 5, 2, False)
 127                 buttons(0) = drawbutton("exit", "x", 5, 3)
 128                 'wait for key or click
 129                 Do
 130                         *page = newpage
 131                         keypress = InKey
 132                         If keypress = "" Then keypress = menumouse(buttons())
 133                 Loop Until keypress <> ""
 134                 'prev/next page
 135                 If keypress=Chr(255)+"P" Or keypress=Chr(255)+"M" Or keypress="n" Then 'down or right or n
 136                         newpage = (*page + 1) Mod maxpage
 137                 ElseIf keypress=Chr(255)+"H" Or keypress=Chr(255)+"K" Or keypress="p" Then 'up or left or p
 138                         newpage = (*page - 1 + maxpage) Mod maxpage
 139                 Else
 140                         newpage = -1
 141                 End If
 142         Loop While newpage <> -1
 143         Return keypress
 144 End Function
 145
 146
 147 Sub opensettings()
 148         Dim title As String = "Settings"
 149         Dim options(2) As String = {"aaaa", "bbbb", "cccc"}
 150         Dim page As UByte = 0
 151         keypress = drawmenu(title, options(), @page)
 152 End Sub
 153
 154
 155 Function openloader(directory As String) As String
 156         Dim title As String = "Load Variation"
 157         Dim page As UByte = 0
 158         'store all filenames
 159         ReDim filenames (0) As String
 160         filenames(0) = Dir(directory + "/*")
 161         Do While Len(filenames(UBound(filenames)))
 162                 ReDim Preserve filenames(UBound(filenames) + 1)
 163                 filenames(UBound(filenames)) = Dir()
 164         Loop
 165         ReDim Preserve filenames(UBound(filenames) - 1) 'last one was empty
 166         'extract titles
 167         Dim titles(UBound(filenames)) As String
 168         Dim As Byte row = 1, fn = 0
 169         Do While Len(filenames(fn))
 170                 titles(fn) = readtitle(directory + "/" + filenames(fn))
 171                 fn += 1
 172         Loop
 173         'draw menu and get key (or click)
 174         Dim As String keypress = drawmenu(title, titles(), @page)
 175         'run a variation (if any)
 176         If Val(keypress) >= 1 And Val(keypress) <= 4 And Len(filenames(Val(keypress) + page*4 - 1)) Then Return directory + "/" + filenames(Val(keypress) + page*4 - 1)
 177 End Function
 178
 179
 180 Sub openhelp()
 181         resizewindow(300,300, "Help")
 182
 183         Color RGB(127,127,127)
 184         Print "Generic Block Game"
 185         Print
 186         Print "This game is free software (GPL3+)."
 187         Print "See fbc.bas for source and details."
 188         Print
 189         Print
 190         Color RGB(255,255,255)
 191         If gravity Then
 192                 Print "Use left and right arrows to move,"
 193                 Print "Up arrow or space to rotate"
 194                 Print "Down arrow to lower, Enter to drop."
 195         Else
 196                 Print "Use arrows to move,"
 197                 Print "Space to rotate, Enter to fix."
 198         End If
 199         Print
 200         Print
 201         Color RGB(127,127,127)
 202         Print "Help for " + game.title
 203         Color RGB(255,255,255)
 204         Print
 205
 206         Dim As UByte a
 207         For a = 0 To UBound(help)
 208                 Print help(a)
 209         Next a
 210
 211         Dim e As EVENT
 212         Do
 213                 keypress=InKey
 214                 ScreenEvent(@e)
 215         Loop Until keypress <> "" Or e.type = EVENT_MOUSE_BUTTON_PRESS
 216
 217         loadTiles(0)
 218         drawplayfield()
 219 End Sub
 220
 221
 222 Sub openmenu()
 223         Dim As Integer w,h
 224         ScreenInfo(w,h)
 225
 226         Dim e As EVENT
 227         Dim As Integer x, y, pressed
 228
 229         Dim menuimg As Any Ptr
 230         resizewindow(150,150, "Menu")
 231         menuimg = ImageCreate(150,150)
 232         BLoad GFXPATH+"/menu.bmp", menuimg
 233         Put(0,0),menuimg,PSet
 234         Do
 235                 keypress=InKey
 236
 237                 If (ScreenEvent(@e)) Then
 238                 Select Case e.type
 239                 Case EVENT_MOUSE_BUTTON_PRESS
 240                     pressed = e.button=1
 241                                         If e.button>=2 Then Exit Do
 242                                         If pressed Then
 243                                                 GetMouse(x,y)
 244                                                 If isin(x,y,0,0) Then 'help
 245                                                         keypress = Chr(255)+";" 'F1
 246                                                 ElseIf isin(x,y,100,0) Then 'quit
 247                                                         keypress = Chr(27) 'Esc
 248                                                 ElseIf isin(x,y,50,50) Then 'tiles
 249                                                         keypress = "t"
 250                                                 ElseIf isin(x,y,0,50) Then 'speed
 251                                                         keypress = "+"
 252                                                 ElseIf isin(x,y,100,50) Then 'score
 253                                                         keypress = "s"
 254                                                 ElseIf isin(x,y,50,0) Then 'restart
 255                                                         keypress = Chr(255)+"<" 'F2
 256                                                 ElseIf isin(x,y,0,100) Then 'load
 257                                                         keypress = "l"
 258                                                 End If
 259                                         End If
 260                 Case EVENT_MOUSE_BUTTON_RELEASE
 261                     pressed = 0
 262                 Case EVENT_MOUSE_MOVE
 263                     If (pressed) Then
 264                                                 ScreenControl GET_WINDOW_POS, x, y
 265                                                 ScreenControl SET_WINDOW_POS, x + e.dx, y + e.dy
 266                     End If
 267                 Case EVENT_WINDOW_CLOSE
 268                                 keypress = Chr(27)
 269                 End Select
 270                 End If
 271
 272                 Select Case keypress
 273                         Case "t"
 274                                 loadTiles(1)
 275                                 ImageDestroy(menuimg)
 276                                 Exit Sub
 277                         Case "+"
 278                                 speed=speed/1.5
 279                                 Exit Do
 280                         Case "s"
 281                                 togglescore()
 282                                 ImageDestroy(menuimg)
 283                                 Exit Sub
 284                         Case Chr(255)+";" 'F1
 285                                 openhelp()
 286                                 Exit Sub
 287                         Case Chr(255)+"<" 'F2
 288                                 gameRestart()
 289                                 Exit Do
 290                         Case "l"
 291                                 If loadgame(openloader(VARPATH)) Then
 292                                         ImageDestroy(menuimg)
 293                                         Exit Sub 'Don't restore window size
 294                                 End If
 295                         Case Chr(27)
 296                                 ImageDestroy(menuimg)
 297                                 quit()
 298                 End Select
 299
 300         Loop Until keypress <> ""
 301         ImageDestroy(menuimg)
 302
 303         resizewindow(w,h)
 304         drawplayfield()
 305 End Sub