3 Copyright
2008, 2018, 2019 Pajo
<xpio at tut dot by
>
5 This program is free software
: you can redistribute it
and/or modify
6 it under the terms of the GNU General
Public License
as published by
7 the Free Software Foundation
, either version
3 of the License
, or
8 (at your
option) any later version
.
10 This program is distributed
in the hope that it will be useful
,
11 but WITHOUT ANY WARRANTY
; without even the implied warranty of
12 MERCHANTABILITY
or FITNESS
FOR A PARTICULAR PURPOSE
. See the
13 GNU General
Public License
for more details
.
15 You should have received a copy of the GNU General
Public License
16 along
with this program
. If not, see
<https
://www
.gnu
.org
/licenses
/>.
19 Open Cons
For Output
As #
3 ' debug
25 Const VARPATH
= "variations"
28 Const SPEEDUP_TIME
= 30
29 Const SPEED_INDICATOR_SIZE
= 8
30 Const SCORE_INDICATOR_SIZE
= 16
31 Const DRAWPLAYFIELD_DELAY
= 0.1
36 Declare Sub imprint(remove As Byte = True, place As Byte = True, noshadow As Byte = True)
38 Declare Function move(as Byte,as Byte=0,As UByte
=0) As Byte
42 As Byte dropping
= False 'Used when dropping with mouse
45 Declare Function isblocked(x
as Byte, y
As Byte=0, typ
As UByte
=0, mode
As Byte=False) As Byte
51 As Byte show_shadow
= True, show_score
= False, show_speed
= False
52 As Byte play_mouse
= True, first_button_turning
= False
61 As Double tim
, speed_timer
, menu_timer
62 As Short score
= 0, hiscore
= 0
66 Dim Shared settings
As settings_type
67 Dim Shared game
As game_type
69 Dim Shared nextvariation
As String
70 ReDim Shared
help () As String
71 Dim Shared
As UByte playabletiles
, numberoftiles
72 Dim Shared
As Short columns
=1, rows
=1
73 Dim Shared
As Byte wrap
, gravity
, randominputs
, randomgoals
, inputrotate
74 ReDim Shared
tilesfiles(0) As String
75 ReDim Shared
randomtable() As UByte
76 Dim Shared keypress
As String
77 Dim Shared tilewidth
As Short
78 Dim Shared tilesimg
As Any Ptr
79 Dim Shared scoreimg
As Any Ptr
80 Dim Shared
As block blok
, shadow
81 Dim Shared
As Byte lazydrawplayfield
= False
82 Dim Shared
As UByte maxgoalsw
= 0, maxgoalsh
= 0
85 Declare Function loadgame(filename
As String) As Byte
86 Declare Sub loadTiles(increment
As Byte=1)
87 Declare Sub initplayfield()
88 Declare Sub drop_shadow()
91 Sub resizewindow(w
As UShort
= game
.w
, h
As Short
= -1, t
As String = game
.title
)
92 Dim As Integer oldw
, oldh
: ScreenInfo oldw
, oldh
93 Dim As Integer oldx
, oldy
: ScreenControl GET_WINDOW_POS
, oldx
, oldy
96 If settings
.show_score
Then h
+= SCORE_INDICATOR_SIZE
97 If settings
.show_speed
Then h
+= SPEED_INDICATOR_SIZE
99 If oldw
= w
And oldh
= h
Then
102 ScreenRes w
, h
, 16, 2
103 If oldx
> 0 And oldy
> 0 Then ScreenControl SET_WINDOW_POS
, oldx
, oldy
109 Function asctonumber(ch
As UByte
) As UByte
110 If ch
=46 Then : Return 0
111 ElseIf ch
=33 Then : Return 254 'start=!=254
112 ElseIf ch
=Asc("@") Then : Return 253 'exit=@=253
113 ElseIf ch
>=48 And ch
<=57 Then : Return ch
-48
114 ElseIf ch
>=65 And ch
<=90 Then : Return ch
-65+10
115 ElseIf ch
>=97 And ch
<=122 Then : Return ch
-97+36
120 Function getImgWidth(filename
As String) As Short
121 Open filename
For Input
As #
2
122 If Err
>0 Then Return 0
129 ReDim Shared
inputsindex(0) As Short
130 ReDim Shared
inputs(0,2) As UByte
131 'inputs and inputsindex are linked arrays. inputsindex shows individual inputs' ends
132 ReDim Shared
goals(0,2) As UByte
135 Sub end_shape(shapes() As UByte
, index
As Byte = False)
136 shapes(UBound(shapes
), 0) = 255
137 shapes(UBound(shapes
), 1) = 255
138 shapes(UBound(shapes
), 2) = 255
140 inputsindex(UBound(inputsindex
)) = UBound(shapes
)
141 ReDim Preserve inputsindex(UBound(inputsindex
) + 1)
143 ReDim Preserve shapes(UBound(shapes
) + 1, 2)
148 Dim As Short strt
, stp
, a
, offset
149 If UBound(inputsindex
) = 1 Then strt
= 0 Else strt
= inputsindex(UBound(inputsindex
) - 1 - 1) + 1 'skip "255" point
150 stp
= inputsindex(UBound(inputsindex
) - 1) - 1 'leave out "255" point
152 ReDim Preserve inputs(UBound(inputs
) + offset
+ 1, 2)
154 'mirror one axis and swap x and y to rotate
155 inputs(a
+ offset
+ 2, 1) = inputs(a
, 0)
156 inputs(strt
+ stp
- a
+ offset
+ 2, 0) = inputs(a
, 1)
157 inputs(a
+ offset
+ 2, 2) = inputs(a
, 2)
162 Sub loadshapes(shapes() As UByte
, index
As Byte = False)
164 If index
Then ReDim inputsindex(0)
167 Do Until l
= "}" Or Eof(1)
171 end_shape(shapes(), index
)
172 If inputrotate
And index
Then
175 end_shape(shapes(), index
)
179 For a
= 0 To Len(l
) - 1
180 shapes(UBound(shapes
), 0) = a
181 shapes(UBound(shapes
), 1) = b
182 If l
[a
]=46 Then : shapes(UBound(shapes
), 2) = 0
183 Else : shapes(UBound(shapes
), 2) = asctonumber(l
[a
])
185 ReDim Preserve shapes(UBound(shapes
) + 1, 2)
189 If Len(l
) > maxgoalsw
Then maxgoalsw
= Len(l
)
190 If b
> maxgoalsh
Then maxgoalsh
= b
195 end_shape(shapes(), index
)
196 If inputrotate
And index
Then
199 end_shape(shapes(), index
)
202 If index
Then ReDim Preserve inputsindex(UBound(inputsindex
) - 1)
206 Declare Sub gameOver()
208 Dim Shared
playfield(0 to columns
-1,0 to rows
-1) as UByte
209 Dim Shared
originalplayfield(0 to columns
-1,0 to rows
-1) as UByte
211 ReDim Shared
nextshape() As UByte
213 Function block
.isblocked(x
as Byte, y
As Byte=0, typ
As UByte
=0, mode
As Byte=False) As Byte
214 Dim As Short strt
, stp
, a
217 If typ
=1 Then strt
=0 Else strt
=inputsindex(typ
-1-1)+1 'preskace se ona 255 tacka
218 stp
=inputsindex(typ
-1)-1 'izostavlja se ona 255 tacka
219 'mode=True = ispituje se origin
221 failed
=inputs(a
,2)<>0 And _
222 playfield(x
+inputs(a
,0),y
+inputs(a
,1))<>254 And _
223 playfield(x
+inputs(a
,0),y
+inputs(a
,1))<>253
224 If Not mode
Then failed
=failed
And playfield(x
+inputs(a
,0),y
+inputs(a
,1))<>0
225 failed
=failed
Or y
+inputs(a
,1)>=rows _
227 Or x
+inputs(a
,0)>=columns _
229 If failed
Then Exit For
236 this
.dropping
= False
237 If randominputs
Then 'permutovati brojeve od 1 do playabletiles
239 ReDim randomtable(playabletiles
) As UByte
240 For a
= 1 To playabletiles
241 randomtable(a
)=fix(rnd
*playabletiles
)+1
248 ReDim startpositions(0) As xy
249 Dim posnumber
As UShort
=0
251 Dim starttyp
As UByte
252 this
.typ
=Fix(RND
*(UBound(inputsindex
)+1))+1
255 For y
=0 to rows
-1 : For x
=0 to columns
-1
256 If originalplayfield(x
,y
)=254 Then
257 If Not this
.isblocked(x
,y
,this
.typ
,True) Then 'dodaj na listu
258 ReDim Preserve startpositions(posnumber
) As xy
259 startpositions(posnumber
)=Type(x
,y
)
265 this
.typ
=nextshape(this
.typ
)
266 If this
.typ
=starttyp
Then
271 Loop Until posnumber
>0
272 posnumber
=fix(rnd
*posnumber
)
273 this
.x
=startpositions(posnumber
).x
274 this
.y
=startpositions(posnumber
).y
278 If Not this
.shadow
Then drop_shadow()
282 'constructor bi se pokretao kod samog deklarisanja, pre playfielda
285 Function getshapewidthheight(typ
As UByte
,geth
As Byte = False) As Short
286 Dim As Short strt
, stp
, a
, maxwidth
=0, maxheight
=0
288 If typ
=1 Then strt
=0 Else strt
=inputsindex(typ
-1-1)+1 'preskace se ona 255 tacka
289 stp
=inputsindex(typ
-1)-1 'izostavlja se ona 255 tacka
291 If maxwidth
<inputs(a
,0) Then maxwidth
=inputs(a
,0)
292 If maxheight
<inputs(a
,1) Then maxheight
=inputs(a
,1)
294 If geth
Then Return maxheight
299 Function block
.move(x
as Byte, y
As Byte=0, typ
As UByte
=0) As Byte 'successful?True/False
305 dw
=(getshapewidthheight(this
.typ
)-getshapewidthheight(typ
)) / 2
309 dh
=(getshapewidthheight(this
.typ
,True)-getshapewidthheight(typ
,True)) / 2
315 this
.imprint(True, False) 'just erase oldx i oldy
317 this
.x
=x
+ this
.x
+ dw
318 this
.y
=y
+ this
.y
+ dh
320 this
.x
=(this
.x
+ columns
) Mod columns
321 If Not gravity
Then this
.y
=(this
.y
+ rows
) Mod rows
324 failed
=failed
Or y
+inputs(a
,1)>=rows _
326 Or x
+inputs(a
,0)>=columns _
331 failed
=this
.isblocked(this
.x
,this
.y
,typ
)
339 If not this
.shadow
Then drop_shadow()
346 Sub markshape(shapestart
As Short
, shapeend
As Short
, x
As Short
, y
As Short
)
347 Dim As Short mx
, my
, q
348 For q
= shapestart
To shapeend
- 1
351 If mx
>= 0 And mx
< columns
And my
>= 0 And my
< rows
And _
352 goals(q
, 2) <> 0 And playfield(mx
, my
) <> 0 And playfield(mx
, my
) < 100 Then
353 playfield(mx
, my
) += 100
359 Function matchshape(x
As Short
,y
As Short
) As Byte
360 Dim As Byte fullshape
,foundshape
=False
361 Dim As Short mx
,my
,shapestart
=0,p
=0,q
363 Dim goalscolors(100) As UByte
'za randomgoals '!max 100 randomgolova
365 For p
=0 To UBound(goals
)
366 If goals(p
,0)=255 And goals(p
,1)=255 And goals(p
,2)=255 Then '255,255,255=end
367 If fullshape
=True Then
368 markshape(shapestart
,p
,x
,y
)
373 For a
=0 To UBound(goalscolors
) : goalscolors(a
)=0 : Next a
374 ElseIf goals(p
,2)<>254 Then
375 'do nothing with fullshape variable if 254(joker)
376 '254="!"=matches also empty space (useful when tiles surrounding matched shape should be destroyed)
379 If mx
<0 Or mx
>columns
-1 Or my
<0 Or my
>rows
-1 Then
381 ElseIf goals(p
,2)=255 Then '255 matches everything except empty space
382 fullshape
= fullshape
And _
383 (playfield(mx
,my
)<>0) And _
384 (playfield(mx
,my
)<>254) And _
385 (playfield(mx
,my
)<>253)
386 ElseIf goals(p
,2)<>0 Then
388 If goalscolors(goals(p
,2))=0 Then
389 If (playfield(mx
,my
)<>0) And _
390 (playfield(mx
,my
)<>254) And _
391 (playfield(mx
,my
)<>253)Then
392 goalscolors(goals(p
,2))=playfield(mx
,my
)
397 fullshape
= fullshape
And (playfield(mx
,my
)=goalscolors(goals(p
,2)) _
398 Or playfield(mx
,my
)=goalscolors(goals(p
,2))+100)
400 fullshape
= fullshape
And (playfield(mx
,my
)=goals(p
,2) _
401 Or playfield(mx
,my
)=goals(p
,2)+100)
410 Sub score(inc
As Short
)
412 If game
.score
> game
.hiscore
Then game
.hiscore
= game
.score
417 Dim As Byte x
, y
, gap
, removed=False, scoremulti=0, existsnextvariation=False, gotonextvariation=True
418 For y
=0 To rows
-1 + maxgoalsh
: For x
=0 To columns
-1 + maxgoalsw
419 If matchshape(x
,y
) Then
422 game
.speed_timer
+= (Timer() - game
.speed_timer
) * 0.5
425 If gravity
Then 'remove >100 (marked shapes)
428 For y
=rows
-1 To 0 Step
-1
429 If playfield(x
,y
)>=100 And playfield(x
,y
)<>254 And playfield(x
,y
)<>253 Then
432 If playfield(x
,y
)=254 Then
433 If originalplayfield(x
,y
)=254 Or originalplayfield(x
,y
)=253 Then
434 playfield(x
,y
+gap
)=originalplayfield(x
,y
)
438 Else playfield(x
,y
+gap
)=playfield(x
,y
)
442 If originalplayfield(x
,y
)=254 Or originalplayfield(x
,y
)=253 Then
443 playfield(x
,y
)=originalplayfield(x
,y
)
449 removed=removed or gap>0
451 If removed Then checksituation()
453 For y
=0 To rows
-1 : For x
=0 To columns
-1
454 If playfield(x
,y
)>100 And playfield(x
,y
)<>254 And playfield(x
,y
)<>253 Then
455 If originalplayfield(x
,y
)=254 Or originalplayfield(x
,y
)=254 Then
456 playfield(x
,y
)=originalplayfield(x
,y
)
463 score(scoremulti
* 10)
465 For y
=0 To rows
-1 : For x
=0 To columns
-1
466 If originalplayfield(x
,y
)=253 Then
467 existsnextvariation
=True
468 If playfield(x
,y
)=253 Then gotonextvariation
=False
471 If existsnextvariation
And gotonextvariation
Then
472 loadgame(VARPATH
+"/"+nextvariation
)
480 Sub putshape(x
As Short
, y
As Short
, typ
As UByte
, nodel
As Byte, noshadow
As Byte)
481 Dim As Short strt
, stp
, a
483 'skip the 255-point that marks the end of the previous shape
484 If typ
= 1 Then strt
= 0 Else strt
=inputsindex(typ
- 1 - 1) + 1
485 stp
= inputsindex(typ
- 1) - 1 'leave out 255-point
486 For a
= strt
To stp
: If inputs(a
, 2) <> 0 Then
490 'don't overwrite blocks with shadow
491 o
= playfield(x
+ inputs(a
, 0), y
+ inputs(a
, 1))
492 If o
= 0 Or o
= 254 Then o
= 253
493 ElseIf randominputs
Then
494 o
= randomtable(inputs(a
, 2))
499 o
= originalplayfield(x
+ inputs(a
, 0), y
+ inputs(a
, 1))
500 'preserve special tiles, but don't restore blocks (if any) from the beginning
501 If Not (o
= 254 Or o
= 253) Then o
= 0
504 playfield(x
+ inputs(a
, 0), y
+ inputs(a
, 1)) = o
509 Sub block
.imprint(remove As Byte = True, place As Byte = True, noshadow As Byte = True)
510 If (Not (settings
.show_shadow
And gravity
) Or noshadow
) And this
.shadow
Then Return
511 If remove Then putshape(this.oldx, this.oldy, this.oldtyp, False, noshadow) 'delete old shape
512 If place
Then putshape(this
.x
, this
.y
, this
.typ
, True, noshadow
) 'put new shape
517 If Not this
.move(0,1) Then
522 If Not this
.shadow
Then game
.tim
= Timer()
527 ReDim playfield(0 To columns
-1,0 To rows
-1) As UByte
529 For y
=0 To rows
-1 : For x
=0 To columns
-1
530 playfield(x
,y
)=originalplayfield(x
,y
)
535 Declare Sub drawplayfield()
537 Sub loadTiles(increment
As Byte)
538 settings
.tileset
+= increment
539 If settings
.tileset
> UBound(tilesfiles
) Then settings
.tileset
= 0
540 If settings
.tileset
< 0 Then settings
.tileset
= UBound(tilesfiles
)
542 Dim tilesfile
As String
543 tilesfile
=GFXPATH
& "/" & tilesfiles(settings
.tileset
)
544 tilewidth
= getImgWidth(tilesfile
)
545 game
.w
= tilewidth
*columns
: game
.h
= tilewidth
*rows
546 tilesimg
= ImageCreate(tilewidth
, tilewidth
*(3+numberoftiles
))
547 BLoad tilesfile
, tilesimg
548 scoreimg
= ImageCreate(130,20)
549 BLoad GFXPATH
+"/brojke.bmp", scoreimg
556 Sub drawscore(hi
As Byte = False)
558 Dim As Byte numberstarted
=False
559 Dim As UShort printscore
= game
.score
560 Dim As UShort offsety
= 0
562 printscore
= game
.hiscore
566 Dim xpx
As UShort
= tilewidth
*columns
567 Line(0,offsety
)-(xpx
,offsety
+ 16),RGB(0,0,0),BF
568 For a
=0 To 9 'max 10 digits - traze se otpozadi
569 If 10^a
> printscore
Then Exit For
570 digit
=Fix((printscore Mod
10^
(a
+1)) / 10^a
)
573 Put (xpx
,offsety
+ 1),scoreimg
,(13,0)-(17,14),PSet
576 Put (xpx
,offsety
+ 1),scoreimg
,(0,0)-(12,14),PSet
579 Put (xpx
,offsety
+ 1),scoreimg
,(-8+digit
*13,0)-(-8+12+digit
*13,14),PSet
582 If printscore
> 0 And printscore
= game
.hiscore
Then
584 Put (xpx
,offsety
+ 1),scoreimg
,(122,0)-(130,14),PSet
591 If settings
.show_score
Then y
+= SCORE_INDICATOR_SIZE
592 Line (0, y
) - (game
.w
, y
+ 7), RGB(22, 22, 22), BF
' background
593 Line (0, y
) - (game
.w
* game
.speed
/ 10, y
+ 3), RGB(222, 222, 222), BF
594 Line (0, y
+ 4) - (game
.w
* (Timer() - game
.speed_timer
) / SPEEDUP_TIME
, y
+ 7), RGB(166, 166, 233), BF
599 ' Prevent too much redraws
600 Static lastdrawplayfield
As Double = 0
601 If Timer() - lastdrawplayfield
< DRAWPLAYFIELD_DELAY
Then
602 lazydrawplayfield
= True
605 lastdrawplayfield
= Timer()
606 lazydrawplayfield
= False
608 shadow
.imprint(False, True, False)
610 Dim As Short offsetx
=0,offsety
=0,offsetpx
=0,offsetpy
=0
611 If settings
.show_score
Then offsetpy
+= SCORE_INDICATOR_SIZE
612 If settings
.show_speed
Then offsetpy
+= SPEED_INDICATOR_SIZE
614 for y
=0 to rows
-1 : for x
=0 to columns
-1
615 If playfield(x
,y
)=0 Then : t
=0
616 ElseIf playfield(x
,y
)=254 Then : t
=1
617 ElseIf playfield(x
,y
)=253 Then : t
=2
618 Else : t
=playfield(x
,y
)+2
620 Put (offsetpx
+(offsetx
+x
)*tilewidth
, offsetpy
+(offsety
+y
)*tilewidth
), _
621 tilesimg
,(0,t
*tilewidth
) - Step(tilewidth
-1,tilewidth
-1),PSet
624 shadow
.imprint(True, False, False)
626 If settings
.show_score
Then drawscore()
634 Dim l
As String, n
As UByte
=0
635 Do Until l
="}" Or Eof(1)
637 ReDim Preserve tilesfiles(n
)
641 ReDim Preserve tilesfiles(n
-2)
646 Dim l
As String, n
As UByte
648 ReDim nextshape(UBound(inputsindex
) + 1) As UByte
649 For n
= 0 To UBound(inputsindex
) Step
4
650 nextshape(n
+ 1) = n
+ 2
651 nextshape(n
+ 2) = n
+ 3
652 nextshape(n
+ 3) = n
+ 4
653 nextshape(n
+ 4) = n
+ 1
657 ReDim nextshape(Len(l
)) As UByte
658 For n
= 0 To Len(l
) 'nextshape(0) is not used
659 nextshape(n
+1)=asctonumber(l
[n
])
667 Dim l
As String, n
As UByte
668 Dim position
As Integer = Seek(1)
670 Do Until l
="}" Or Eof(1)
673 If Len(l
)>columns
Then columns
=Len(l
)
675 ReDim originalplayfield(0 to columns
-1,0 to rows
-1) as UByte
679 Do Until l
="}" Or Eof(1)
684 If l
[a
]=46 Then : originalplayfield(a
,b
-1)=0
685 Else : originalplayfield(a
,b
-1)=asctonumber(l
[a
])
689 originalplayfield(a
,b
-1)=n
690 If n
>numberoftiles
And n
<100 Then numberoftiles
=n
693 If playabletiles
>numberoftiles
Then numberoftiles
=playabletiles
704 Do Until l
="}" Or Eof(1)
706 wrap
=wrap
Or l
="wrap"
707 gravity
=gravity
Or l
="gravity"
708 inputrotate
=inputrotate
Or l
="inputrotate"
709 randominputs
=randominputs
Or l
="randominputs"
710 randomgoals
=randomgoals
Or l
="randomgoals"
711 If Left(l
,6)="tiles:" Then playabletiles
=CInt(Mid(l
,7))
717 If Not (settings
.show_shadow
And gravity
) Then Return
720 shadow
.typ
= blok
.typ
722 Do : Loop While shadow
.move(0,1)
741 If l
="}" Then Exit Do
742 ReDim Preserve help(UBound(help
) + 1)
743 help(UBound(help
)) = l
748 Function loadgame(filename
As String) As Byte
749 If filename
= "" Then Return False
750 Dim l
As String, loadedcycle
As Byte
751 Open filename
For Input
As #
1
752 If Err
>0 Then Print
"Error opening the file":End
762 Line Input #
1,nextvariation
768 loadshapes(inputs(),True)
779 If Not loadedcycle
Then loadcycle()
788 settings
.show_score
= Not settings
.show_score
796 ImageDestroy(tilesimg
)
797 ImageDestroy(scoreimg
)
805 Sub drop_but_dont_fix(y
As Integer)
806 If Int(y
/ tilewidth
- blok
.y
) <= 0 Then Return
807 If blok
.move(0,1) Then
815 Function windowmouse(mode
As String) As String
817 Static pressed
As Integer = 0
818 If (ScreenEvent(@e
)) Then
820 Case EVENT_MOUSE_BUTTON_PRESS
821 If mode
= "gameover" Then Return " " 'Space=end gameover
822 If settings
.play_mouse
Then
823 If e
.button
=1 And gravity
Then
824 If settings
.first_button_turning
And Int(e
.y
/ tilewidth
- blok
.y
) <= 0 Then
825 Return " " 'Space = turn
827 drop_but_dont_fix(e
.y
)
832 If e
.button
=2 Then Return " " 'Space = turn
834 If Not settings
.play_mouse
Or e
.button
>2 Then Return Chr(27) 'Esc = open menu
835 Case EVENT_MOUSE_BUTTON_RELEASE
836 If settings
.play_mouse
And e
.button
=1 Then
837 If Not gravity
Or blok
.dropping
Then Return Chr(13) 'Enter = drop
839 Case EVENT_WINDOW_CLOSE
841 Case EVENT_MOUSE_MOVE
842 If e
.x
> 0 And e
.x
< game
.w
And settings
.play_mouse
And mode
<> "gameover"Then
843 While Int(e
.x
/ tilewidth
- blok
.x
) <> 0 And blok
.move(Sgn(Int(e
.x
/ tilewidth
- blok
.x
)))
846 If blok
.dropping
Then drop_but_dont_fix(e
.y
)
848 While Int(e
.y
/ tilewidth
- blok
.y
) <> 0 And blok
.move(0, Sgn(Int(e
.y
/ tilewidth
- blok
.y
)))
859 Dim As Short starty
= 0, y
= 0, endy
860 Dim As Byte scoredrawn
= False, hiscoredrawn
= False
862 If settings
.show_score
Then starty
+= SCORE_INDICATOR_SIZE
864 endy
= game
.h
+ starty
- 6
865 If settings
.show_speed
Then endy
+= SPEED_INDICATOR_SIZE
870 If Timer() - tim2
> 0.5 Then
872 If keypress
= "" Then keypress
= windowmouse("gameover")
874 While InKey() <> "" : Wend 'prevents exit from gameover screen for 0.5 seconds
878 If Timer() - game
.tim
> 0.03 Then
880 Line (0, y
) - (game
.w
, y
+ 6), RGB(0, 0, 0), BF
881 Put(game
.w
/ 2 - 47 / 2, y
+ 1), scoreimg
,(52, 15) - (99, 19), PSet
887 If y
> SCORE_INDICATOR_SIZE
+ 4 And Not scoredrawn
Then
891 If y
> SCORE_INDICATOR_SIZE
+ 24 And Not hiscoredrawn
Then
895 Loop Until keypress
<>""
902 If Not loadgame(Command
) Then
903 If Not loadgame(openloader(VARPATH
)) Then End
906 game
.speed_timer
= game
.tim
908 If lazydrawplayfield
Then drawplayfield()
909 If settings
.show_speed
Then drawspeed()
912 If keypress
= "" Then keypress
= windowmouse("play")
914 Case Chr(255) + "K" 'left
917 Case Chr(255) + "M" 'right
921 blok
.move(0,0,nextshape(blok
.typ
)) 'cycle
923 Case Chr(255) + "H" 'move up or rotate
925 blok
.move(0,0,nextshape(blok
.typ
)) 'cycle
930 Case Chr(255) + "P" 'down
940 Case Chr(13) 'Enter = fix or drop
942 Do : score(1) : Loop While blok
.move(0,1)
950 Case "o", "O" 'settings
951 game
.menu_timer
= Timer()
953 'make up for lost time
954 game
.tim
+= Timer() - game
.menu_timer
955 game
.speed_timer
+= Timer() - game
.menu_timer
956 resizewindow() : drawplayfield()
958 game
.menu_timer
= Timer()
959 If Not loadgame(openloader(VARPATH
)) Then
960 resizewindow() 'restore window size and title
961 'make up for lost time
962 game
.tim
+= Timer() - game
.menu_timer
963 game
.speed_timer
+= Timer() - game
.menu_timer
966 Case Chr(255)+";" 'F1
967 game
.menu_timer
= Timer()
969 'make up for lost time
970 game
.tim
+= Timer() - game
.menu_timer
971 game
.speed_timer
+= Timer() - game
.menu_timer
972 Case Chr(255)+"<" 'F2
977 game
.menu_timer
= Timer()
979 'make up for lost time
980 game
.tim
+= Timer() - game
.menu_timer
981 game
.speed_timer
+= Timer() - game
.menu_timer
984 If gravity
And Timer() - game
.tim
> SPEED
/ game
.speed
then
988 'speedup based on time
989 If gravity
And game
.speed
< MAX_SPEED
And Timer() > game
.speed_timer
+ SPEEDUP_TIME
Then
990 game
.speed_timer
= Timer()