Show Posts

1

Programs / ascII almost smooth pixel scroll

« on: April 08, 2022, 09:44:54 am »

just messing around with smooth scrolling ascii text mode..

screendata$(holds then entire screen map) no need to print to screen. use mid$ to store x,y data instead to screendata$

adjust the timer to adjust speed of frame being drawn

in screen draw routine take out dr%=0 in line 65 to have continued scroll
to disable wrap around change line 43 to b$=" " and line 57 to a$=" "

Screen _NewImage(32 * 8, 24 * 16, 256)

Timer On
On Timer(0.0066) GoSub MVE:
Randomize Timer
Dim screendata$(24)

For i = 1 To 24
For j = 1 To 32
screendata$(i) = screendata$(i) + Chr$(Int(Rnd(1) * 26) + 65)
Next j
Print screendata$(i)
Next i
Cls
dr% = 0
ZX% = 8
Do:
If Int(Rnd(1) * 75500) = 100 Then GoSub RAND
I$ = InKey$
If I$ = "Q" Then dr% = 1: I$ = ""
If I$ = "E" Then dr% = 2: I$ = ""
If I$ = "W" Then dr% = 0: I$ = ""
Loop While I$ = ""
Timer Off
End

MVE:
If dr% = 0 Then
For i = 1 To 24
Color 1: _PrintString (ZX%, i * 16 - 15), screendata$(i)
Color 2: Locate i, 1: Print "Û";: Locate i, 32: Print "Û";
Next i
End If
If dr% = 1 Then
For i = 1 To 24
Color 1: _PrintString (ZX%, i * 16 - 15), screendata$(i)
Color 2: Locate i, 1: Print "Û";: Locate i, 32: Print "Û";
Next i
ZX% = ZX% - 1
If ZX% < 0 Then
For i = 1 To 24
A$ = Right$(screendata$(i), 31)
B$ = Left$(screendata$(i), 1)
screendata$(i) = A$ + B$
Next i
ZX% = 7
End If
End If
If dr% = 2 Then
For i = 1 To 24
Color 1: _PrintString (ZX%, i * 16 - 15), screendata$(i)
Color 2: Locate i, 1: Print "Û";: Locate i, 32: Print "Û";
Next i
ZX% = ZX% + 1
If ZX% > 8 Then
For i = 1 To 24
A$ = Right$(screendata$(i), 1)
B$ = Left$(screendata$(i), 31)
screendata$(i) = A$ + B$
Next i
ZX% = 1
End If
End If
_Display
dr% = 0
Return
RAND:
X = Int(Rnd(1) * 24 + 1)
Y = Int(Rnd(1) * 31 + 1)
Mid$(screendata$(X), Y, 1) = "\"
Return

2

QB64 Discussion / play command on linux doing weird thing on qb64 1.15

« on: June 22, 2021, 05:02:14 am »

just a question:

on qb64 1.15 linux i have got a little routine as below

x=0
do
play a$(x),b$(x)
x=x+1
if x>719 then x=0
while inkey$="" loop
end

when i press a key it exits like it should but the problem with this it continues to play the two voice music on my pc speaker

i want it to imediatly stop play though. it buffers the music but i dont want it play when i press the key as this is my title screen music.

i want it to play two notes then check key. if key pressed then exit loop. stop playing else loop play next two notes
_delay does not fix

thank you for any advice.

3

Programs / boulderdash update pmackay

« on: August 29, 2020, 05:39:48 pm »

this is just an update to my boulder dash. has some bug fixes. needed are the other files from the original file you have downloaded.

have included the zip from my original code for download.

still work in progress. but very playable

*** (update-1.13) Download the files below (boulderrtestrun.zip and BOULDERS13.bas). unzip the file in qb64. copy the BOULDERS13.bas in qb64 and compile. updated file from 1st september 2020....

The update has got the Amoeba to recognize and fix the fireflies and butterflies from staying behind. now fixed. Amoeba still needed to detect when stuck (no where to move = trapped sequence). running from timer for now.

Code: Text: [Select]

4

Programs / Boulderdash

« on: February 15, 2020, 04:39:38 am »

reworked on graphics (draw frame routine easier to read)

FPS1:
CLS
SELECT CASE ANIMATE%
CASE 1
FOR J% = 1 TO 40
FOR I% = 1 TO 22
B% = SCREENMEM%(J%, I%)
SELECT CASE B%
CASE WALL: PUT (J% * 16, I% * 16), BORDER()
CASE BUTTERFLY: PUT (J% * 16, I% * 16), BUTTERFLY1()
CASE FIREFLY: PUT (J% * 16, I% * 16), FIREFLY1()
CASE DIRT: PUT (J% * 16, I% * 16), DIRT()
CASE DIAMOND: PUT (J% * 16, I% * 16), DIAMOND1()
CASE ROCK: PUT (J% * 16, I% * 16), ROCK()
CASE SPACE: PUT (J% * 16, I% * 16), EXPLODE4()
CASE BRICK1: PUT (J% * 16, I% * 16), BRICK1()
CASE AMOEBA: PUT (J% * 16, I% * 16), AMOEBA1()
CASE CRUMBLE: PUT (J% * 16, I% * 16), CRUMBLE()
CASE EXITCLOSED: PUT (J% * 16, I% * 16), WALLFLASH1()
CASE EXITDOOR: IF FLAG% = 1 THEN PUT (J% * 16, I% * 16), WALLFLASH1() ELSE PUT (J% * 16, I% * 16), WALLFLASH2()
END SELECT
NEXT I%
NEXT J%
CASE 2
FOR J% = 1 TO 40
FOR I% = 1 TO 22
B% = SCREENMEM%(J%, I%)
SELECT CASE B%
CASE WALL: PUT (J% * 16, I% * 16), BORDER()
CASE BUTTERFLY: PUT (J% * 16, I% * 16), BUTTERFLY2()
CASE FIREFLY: PUT (J% * 16, I% * 16), FIREFLY2()
CASE DIRT: PUT (J% * 16, I% * 16), DIRT()
CASE DIAMOND: PUT (J% * 16, I% * 16), DIAMOND2()
CASE ROCK: PUT (J% * 16, I% * 16), ROCK()
CASE SPACE: PUT (J% * 16, I% * 16), EXPLODE4()
CASE BRICK1: PUT (J% * 16, I% * 16), BRICK1()
CASE AMOEBA: PUT (J% * 16, I% * 16), AMOEBA2()
CASE CRUMBLE: PUT (J% * 16, I% * 16), CRUMBLE()
CASE EXITCLOSED: PUT (J% * 16, I% * 16), WALLFLASH1()
CASE EXITDOOR: IF FLAG% = 1 THEN PUT (J% * 16, I% * 16), WALLFLASH2() ELSE PUT (J% * 16, I% * 16), WALLFLASH2()
END SELECT
NEXT I%
NEXT J%
CASE 3
FOR J% = 1 TO 40
FOR I% = 1 TO 22
B% = SCREENMEM%(J%, I%)
SELECT CASE B%
CASE WALL: PUT (J% * 16, I% * 16), BORDER()
CASE BUTTERFLY: PUT (J% * 16, I% * 16), BUTTERFLY3()
CASE FIREFLY: PUT (J% * 16, I% * 16), FIREFLY3()
CASE DIRT: PUT (J% * 16, I% * 16), DIRT()
CASE DIAMOND: PUT (J% * 16, I% * 16), DIAMOND3()
CASE ROCK: PUT (J% * 16, I% * 16), ROCK()
CASE SPACE: PUT (J% * 16, I% * 16), EXPLODE4()
CASE BRICK1: PUT (J% * 16, I% * 16), BRICK1()
CASE AMOEBA: PUT (J% * 16, I% * 16), AMOEBA3()
CASE CRUMBLE: PUT (J% * 16, I% * 16), CRUMBLE()
CASE EXITCLOSED: PUT (J% * 16, I% * 16), WALLFLASH1()
CASE EXITDOOR: IF FLAG% = 1 THEN PUT (J% * 16, I% * 16), WALLFLASH1() ELSE PUT (J% * 16, I% * 16), WALLFLASH2()
END SELECT
NEXT I%
NEXT J%
CASE 4
FOR J% = 1 TO 40
FOR I% = 1 TO 22
B% = SCREENMEM%(J%, I%)
SELECT CASE B%
CASE WALL: PUT (J% * 16, I% * 16), BORDER()
CASE BUTTERFLY: PUT (J% * 16, I% * 16), BUTTERFLY4()
CASE FIREFLY: PUT (J% * 16, I% * 16), FIREFLY4()
CASE DIRT: PUT (J% * 16, I% * 16), DIRT()
CASE DIAMOND: PUT (J% * 16, I% * 16), DIAMOND4()
CASE ROCK: PUT (J% * 16, I% * 16), ROCK()
CASE SPACE: PUT (J% * 16, I% * 16), EXPLODE4()
CASE BRICK1: PUT (J% * 16, I% * 16), BRICK1()
CASE AMOEBA: PUT (J% * 16, I% * 16), AMOEBA4()
CASE CRUMBLE: PUT (J% * 16, I% * 16), CRUMBLE()
CASE EXITCLOSED: PUT (J% * 16, I% * 16), WALLFLASH1()
CASE EXITDOOR: IF FLAG% = 1 THEN PUT (J% * 16, I% * 16), WALLFLASH2() ELSE PUT (J% * 16, I% * 16), WALLFLASH2()
END SELECT
NEXT I%
NEXT J%

CASE 5
FOR J% = 1 TO 40
FOR I% = 1 TO 22
B% = SCREENMEM%(J%, I%)
SELECT CASE B%
CASE WALL: PUT (J% * 16, I% * 16), BORDER()
CASE BUTTERFLY: PUT (J% * 16, I% * 16), BUTTERFLY5()
CASE FIREFLY: PUT (J% * 16, I% * 16), FIREFLY5()
CASE DIRT: PUT (J% * 16, I% * 16), DIRT()
CASE DIAMOND: PUT (J% * 16, I% * 16), DIAMOND5()
CASE ROCK: PUT (J% * 16, I% * 16), ROCK()
CASE SPACE: PUT (J% * 16, I% * 16), EXPLODE4()
CASE BRICK1: PUT (J% * 16, I% * 16), BRICK1()
CASE AMOEBA: PUT (J% * 16, I% * 16), AMOEBA5()
CASE CRUMBLE: PUT (J% * 16, I% * 16), CRUMBLE()
CASE EXITCLOSED: PUT (J% * 16, I% * 16), WALLFLASH1()
CASE EXITDOOR: IF FLAG% = 1 THEN PUT (J% * 16, I% * 16), WALLFLASH1() ELSE PUT (J% * 16, I% * 16), WALLFLASH2()
END SELECT
NEXT I%
NEXT J%
CASE 6
FOR J% = 1 TO 40
FOR I% = 1 TO 22
B% = SCREENMEM%(J%, I%)
SELECT CASE B%
CASE WALL: PUT (J% * 16, I% * 16), BORDER()
CASE BUTTERFLY: PUT (J% * 16, I% * 16), BUTTERFLY6()
CASE FIREFLY: PUT (J% * 16, I% * 16), FIREFLY6()
CASE DIRT: PUT (J% * 16, I% * 16), DIRT()
CASE DIAMOND: PUT (J% * 16, I% * 16), DIAMOND6()
CASE ROCK: PUT (J% * 16, I% * 16), ROCK()
CASE SPACE: PUT (J% * 16, I% * 16), EXPLODE4()
CASE BRICK1: PUT (J% * 16, I% * 16), BRICK1()
CASE AMOEBA: PUT (J% * 16, I% * 16), AMOEBA6()
CASE CRUMBLE: PUT (J% * 16, I% * 16), CRUMBLE()
CASE EXITCLOSED: PUT (J% * 16, I% * 16), WALLFLASH1()
CASE EXITDOOR: IF FLAG% = 1 THEN PUT (J% * 16, I% * 16), WALLFLASH2() ELSE PUT (J% * 16, I% * 16), WALLFLASH2()
END SELECT
NEXT I%
NEXT J%
CASE 7
FOR J% = 1 TO 40
FOR I% = 1 TO 22
B% = SCREENMEM%(J%, I%)
SELECT CASE B%
CASE WALL: PUT (J% * 16, I% * 16), BORDER()
CASE BUTTERFLY: PUT (J% * 16, I% * 16), BUTTERFLY7()
CASE FIREFLY: PUT (J% * 16, I% * 16), FIREFLY7()
CASE DIRT: PUT (J% * 16, I% * 16), DIRT()
CASE DIAMOND: PUT (J% * 16, I% * 16), DIAMOND7()
CASE ROCK: PUT (J% * 16, I% * 16), ROCK()
CASE SPACE: PUT (J% * 16, I% * 16), EXPLODE4()
CASE BRICK1: PUT (J% * 16, I% * 16), BRICK1()
CASE AMOEBA: PUT (J% * 16, I% * 16), AMOEBA7()
CASE CRUMBLE: PUT (J% * 16, I% * 16), CRUMBLE()
CASE EXITCLOSED: PUT (J% * 16, I% * 16), WALLFLASH1()
CASE EXITDOOR: IF FLAG% = 1 THEN PUT (J% * 16, I% * 16), WALLFLASH1() ELSE PUT (J% * 16, I% * 16), WALLFLASH2()
END SELECT
NEXT I%
NEXT J%
CASE 8
FOR J% = 1 TO 40
FOR I% = 1 TO 22
B% = SCREENMEM%(J%, I%)
SELECT CASE B%
CASE WALL: PUT (J% * 16, I% * 16), BORDER()
CASE BUTTERFLY: PUT (J% * 16, I% * 16), BUTTERFLY8()
CASE FIREFLY: PUT (J% * 16, I% * 16), FIREFLY8()
CASE DIRT: PUT (J% * 16, I% * 16), DIRT()
CASE DIAMOND: PUT (J% * 16, I% * 16), DIAMOND8()
CASE ROCK: PUT (J% * 16, I% * 16), ROCK()
CASE SPACE: PUT (J% * 16, I% * 16), EXPLODE4()
CASE BRICK1: PUT (J% * 16, I% * 16), BRICK1()
CASE AMOEBA: PUT (J% * 16, I% * 16), AMOEBA8()
CASE CRUMBLE: PUT (J% * 16, I% * 16), CRUMBLE()
CASE EXITCLOSED: PUT (J% * 16, I% * 16), WALLFLASH1()
CASE EXITDOOR: IF FLAG% = 1 THEN PUT (J% * 16, I% * 16), WALLFLASH2() ELSE PUT (J% * 16, I% * 16), WALLFLASH2()
END SELECT
NEXT I%
NEXT J%

END SELECT
_DISPLAY
RETURN

also fixed error in code for Fireflys and Butterflies. Now working as should. similar to original. but works great. (not copy is my own original code).. infarct all code is mine.

FIREFLYMOVE:
FTAD% = 1
FOR FTAD% = 1 TO 100
SELECT CASE FIREFLYD(FTAD%)
CASE 0
GOTO FIREFLYPASSMOVE
CASE 1 ' UP
FBUT%% = SCREENMEM%((FIREFLYY(FTAD%)), FIREFLYX(FTAD%) - 1)
FCUT%% = SCREENMEM%((FIREFLYY(FTAD%) - 1), FIREFLYX(FTAD%))
FDUT%% = SCREENMEM%((FIREFLYY(FTAD%) + 1), FIREFLYX(FTAD%))
IF FCUT%% = SPACE THEN SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = SPACE: FIREFLYY(FTAD%) = FIREFLYY(FTAD%) - 1: SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = FIREFLY: FIREFLYD(FTAD%) = 2: GOTO FIREFLYPASSMOVE
IF FBUT%% = SPACE THEN SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = SPACE: FIREFLYX(FTAD%) = FIREFLYX(FTAD%) - 1: SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = FIREFLY: FIREFLYD(FTAD%) = 1: GOTO FIREFLYPASSMOVE
IF FDUT%% = SPACE THEN SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = SPACE: FIREFLYY(FTAD%) = FIREFLYY(FTAD%) + 1: SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = FIREFLY: FIREFLYD(FTAD%) = 4: GOTO FIREFLYPASSMOVE
FIREFLYD(FTAD%) = 3
CASE 2 ' LEFT
FBUT%% = SCREENMEM%((FIREFLYY(FTAD%) - 1), FIREFLYX(FTAD%))
FCUT%% = SCREENMEM%((FIREFLYY(FTAD%)), FIREFLYX(FTAD%) + 1)
FDUT%% = SCREENMEM%((FIREFLYY(FTAD%)), FIREFLYX(FTAD%) - 1)
IF FCUT%% = SPACE THEN SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = SPACE: FIREFLYX(FTAD%) = FIREFLYX(FTAD%) + 1: SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = FIREFLY: FIREFLYD(FTAD%) = 3: GOTO FIREFLYPASSMOVE
IF FBUT%% = SPACE THEN SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = SPACE: FIREFLYY(FTAD%) = FIREFLYY(FTAD%) - 1: SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = FIREFLY: FIREFLYD(FTAD%) = 2: GOTO FIREFLYPASSMOVE
IF FDUT%% = SPACE THEN SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = SPACE: FIREFLYX(FTAD%) = FIREFLYX(FTAD%) - 1: SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = FIREFLY: FIREFLYD(FTAD%) = 1: GOTO FIREFLYPASSMOVE
FIREFLYD(FTAD%) = 4
CASE 3 'DOWN
FBUT%% = SCREENMEM%((FIREFLYY(FTAD%)), FIREFLYX(FTAD%) + 1)
FCUT%% = SCREENMEM%((FIREFLYY(FTAD%) + 1), FIREFLYX(FTAD%))
FDUT%% = SCREENMEM%((FIREFLYY(FTAD%) - 1), FIREFLYX(FTAD%))
IF FCUT%% = SPACE THEN SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = SPACE: FIREFLYY(FTAD%) = FIREFLYY(FTAD%) + 1: SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = FIREFLY: FIREFLYD(FTAD%) = 4: GOTO FIREFLYPASSMOVE
IF FBUT%% = SPACE THEN SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = SPACE: FIREFLYX(FTAD%) = FIREFLYX(FTAD%) + 1: SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = FIREFLY: FIREFLYD(FTAD%) = 3: GOTO FIREFLYPASSMOVE
IF FDUT%% = SPACE THEN SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = SPACE: FIREFLYY(FTAD%) = FIREFLYY(FTAD%) - 1: SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = FIREFLY: FIREFLYD(FTAD%) = 2: GOTO FIREFLYPASSMOVE
FIREFLYD(FTAD%) = 1
CASE 4 'RIGHT
FBUT%% = SCREENMEM%((FIREFLYY(FTAD%) + 1), FIREFLYX(FTAD%))
FCUT%% = SCREENMEM%((FIREFLYY(FTAD%)), FIREFLYX(FTAD%) - 1)
FDUT%% = SCREENMEM%((FIREFLYY(FTAD%)), FIREFLYX(FTAD%) + 1)
IF FCUT%% = SPACE THEN SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = SPACE: FIREFLYX(FTAD%) = FIREFLYX(FTAD%) - 1: SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = FIREFLY: FIREFLYD(FTAD%) = 1: GOTO FIREFLYPASSMOVE
IF FBUT%% = SPACE THEN SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = SPACE: FIREFLYY(FTAD%) = FIREFLYY(FTAD%) + 1: SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = FIREFLY: FIREFLYD(FTAD%) = 4: GOTO FIREFLYPASSMOVE
IF FDUT%% = SPACE THEN SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = SPACE: FIREFLYX(FTAD%) = FIREFLYX(FTAD%) + 1: SCREENMEM%(FIREFLYY(FTAD%), FIREFLYX(FTAD%)) = FIREFLY: FIREFLYD(FTAD%) = 3: GOTO FIREFLYPASSMOVE
FIREFLYD(FTAD%) = 2
FIREFLYPASSMOVE:
END SELECT
NEXT FTAD%
'GOSUB FPS1
RETURN

BUTTERMOVE:
TAD% = 1
FOR TAD% = 1 TO 100
SELECT CASE BUTTERFLYD(TAD%)
CASE 0
GOTO PASSMOVE
CASE 3 ' UP
BUT% = SCREENMEM%((BUTTERFLYY(TAD%)), BUTTERFLYX(TAD%) - 1)
CUT% = SCREENMEM%((BUTTERFLYY(TAD%) + 1), BUTTERFLYX(TAD%))
DUT% = SCREENMEM%((BUTTERFLYY(TAD%) - 1), BUTTERFLYX(TAD%))
IF CUT% = SPACE THEN SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = SPACE: BUTTERFLYY(TAD%) = BUTTERFLYY(TAD%) + 1: SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = BUTTERFLY: BUTTERFLYD(TAD%) = 4: GOTO PASSMOVE
IF BUT% = SPACE THEN SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = SPACE: BUTTERFLYX(TAD%) = BUTTERFLYX(TAD%) - 1: SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = BUTTERFLY: BUTTERFLYD(TAD%) = 1: GOTO PASSMOVE
IF DUT% = SPACE THEN SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = SPACE: BUTTERFLYY(TAD%) = BUTTERFLYY(TAD%) - 1: SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = BUTTERFLY: BUTTERFLYD(TAD%) = 2: GOTO PASSMOVE
BUTTERFLYD(TAD%) = 1
CASE 2 ' LEFT
BUT% = SCREENMEM%((BUTTERFLYY(TAD%) - 1), BUTTERFLYX(TAD%))
CUT% = SCREENMEM%((BUTTERFLYY(TAD%)), BUTTERFLYX(TAD%) - 1)
DUT% = SCREENMEM%((BUTTERFLYY(TAD%)), BUTTERFLYX(TAD%) + 1)
IF CUT% = SPACE THEN SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = SPACE: BUTTERFLYX(TAD%) = BUTTERFLYX(TAD%) - 1: SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = BUTTERFLY: BUTTERFLYD(TAD%) = 1: GOTO PASSMOVE
IF BUT% = SPACE THEN SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = SPACE: BUTTERFLYY(TAD%) = BUTTERFLYY(TAD%) - 1: SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = BUTTERFLY: BUTTERFLYD(TAD%) = 2: GOTO PASSMOVE
IF DUT% = SPACE THEN SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = SPACE: BUTTERFLYX(TAD%) = BUTTERFLYX(TAD%) + 1: SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = BUTTERFLY: BUTTERFLYD(TAD%) = 3: GOTO PASSMOVE
BUTTERFLYD(TAD%) = 4
CASE 1 'DOWN
BUT% = SCREENMEM%((BUTTERFLYY(TAD%)), BUTTERFLYX(TAD%) + 1)
CUT% = SCREENMEM%((BUTTERFLYY(TAD%) - 1), BUTTERFLYX(TAD%))
DUT% = SCREENMEM%((BUTTERFLYY(TAD%) + 1), BUTTERFLYX(TAD%))
IF CUT% = SPACE THEN SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = SPACE: BUTTERFLYY(TAD%) = BUTTERFLYY(TAD%) - 1: SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = BUTTERFLY: BUTTERFLYD(TAD%) = 2: GOTO PASSMOVE
IF BUT% = SPACE THEN SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = SPACE: BUTTERFLYX(TAD%) = BUTTERFLYX(TAD%) + 1: SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = BUTTERFLY: BUTTERFLYD(TAD%) = 3: GOTO PASSMOVE
IF DUT% = SPACE THEN SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = SPACE: BUTTERFLYY(TAD%) = BUTTERFLYY(TAD%) + 1: SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = BUTTERFLY: BUTTERFLYD(TAD%) = 4: GOTO PASSMOVE
BUTTERFLYD(TAD%) = 3
CASE 4 'RIGHT
BUT% = SCREENMEM%((BUTTERFLYY(TAD%) + 1), BUTTERFLYX(TAD%))
CUT% = SCREENMEM%((BUTTERFLYY(TAD%)), BUTTERFLYX(TAD%) + 1)
DUT% = SCREENMEM%((BUTTERFLYY(TAD%)), BUTTERFLYX(TAD%) - 1)
IF CUT% = SPACE THEN SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = SPACE: BUTTERFLYX(TAD%) = BUTTERFLYX(TAD%) + 1: SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = BUTTERFLY: BUTTERFLYD(TAD%) = 3: GOTO PASSMOVE
IF BUT% = SPACE THEN SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = SPACE: BUTTERFLYY(TAD%) = BUTTERFLYY(TAD%) + 1: SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = BUTTERFLY: BUTTERFLYD(TAD%) = 4: GOTO PASSMOVE
IF DUT% = SPACE THEN SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = SPACE: BUTTERFLYX(TAD%) = BUTTERFLYX(TAD%) - 1: SCREENMEM%(BUTTERFLYY(TAD%), BUTTERFLYX(TAD%)) = BUTTERFLY: BUTTERFLYD(TAD%) = 1: GOTO PASSMOVE
BUTTERFLYD(TAD%) = 2
PASSMOVE:
END SELECT
NEXT TAD%
GOSUB FPS1
GOSUB FIREFLYMOVE
RETURN

sprite data is written as

DATA 33333333300333033103333333333333,33333333300333033103333333333333,33333333300333033103333333333333,33333333300333033103333333333333: ' * BORDER (EDGE TILE)

colors are represented as 1=color 1 2=color 2 3=color3 0=bkground

data is read as left top (4x8), right top (4x8), bottom left (4x8), bottom right (4x8) all in 3 forground and 1 back ground. so four colours only
eg. blocks are 1=x2 block 2=x2 block 3=x2 block 0=bkg(nil colour) 4 dots wide x 8 dots down (grid is 4x8,4x8 =16 x 2 wide 23 down (16x23 character)

5

QB64 Discussion / BoulderDash butterfly movement (AI).. QB64 pmackay

« on: October 30, 2019, 07:36:52 am »

WIDTH 40
DIM a$(10), BX(10), BY(10), BD(10)
DIM SCREENMEM%(20, 9)
CONST BUTTERFLY = 1, SPACE = 32, WALL = 79
a$(1) = "wwwwwwwwwwwwwwwwwwww"
a$(2) = "w . . .w"
a$(3) = "w . . . . ... .w"
a$(4) = "w ......... . . . w"
a$(5) = "w . . . w"
a$(6) = "w.......... ..... .w"
a$(7) = "wz .w"
a$(8) = "w... ... ........w"
a$(9) = "wwwwwwwwwwwwwwwwwwww"

TID% = 0
FOR I = 1 TO 10
TID% = 0
FOR J = 1 TO 9
IF MID$(a$(J), I, 1) = "z" THEN TID% = TID% + 1: BX(TID%) = J: BY(TID%) = I: BD(TID%) = 1
NEXT J
NEXT I
FOR J = 1 TO 9
FOR I = 1 TO 20
B$ = MID$(a$(J), I, 1)
SCREENMEM%(I, J) = VAL(B$)
LOCATE J, I: PRINT B$
NEXT I
NEXT J
DO
_LIMIT 20
I$ = INKEY$: IF I$ = "Q" THEN EXIT DO
GOSUB FPS
GOSUB MOVE
LOOP
END
MOVE:
SELECT CASE BD(1)

CASE 0
GOTO PASSMOVE

CASE 1 ' UP
B$ = MID$(a$(BX(1) - 1), BY(1), 1)
C$ = MID$(a$(BX(1)), BY(1) - 1, 1)
D$ = MID$(a$(BX(1)), BY(1) + 1, 1)
IF C$ = " " THEN MID$(a$(BX(1)), BY(1), 1) = " ": BY(1) = BY(1) - 1: MID$(a$(BX(1)), BY(1), 1) = "z": BD(1) = 2: GOTO PASSMOVE
IF B$ = " " THEN MID$(a$(BX(1)), BY(1), 1) = " ": BX(1) = BX(1) - 1: MID$(a$(BX(1)), BY(1), 1) = "z": BD(1) = 1: GOTO PASSMOVE
IF D$ = " " THEN MID$(a$(BX(1)), BY(1), 1) = " ": BY(1) = BY(1) + 1: MID$(a$(BX(1)), BY(1), 1) = "z": BD(1) = 4: GOTO PASSMOVE
BD(1) = 3

CASE 2 ' LEFT
B$ = MID$(a$(BX(1)), BY(1) - 1, 1)
C$ = MID$(a$(BX(1) + 1), BY(1), 1)
D$ = MID$(a$(BX(1) - 1), BY(1), 1)
IF C$ = " " THEN MID$(a$(BX(1)), BY(1), 1) = " ": BX(1) = BX(1) + 1: MID$(a$(BX(1)), BY(1), 1) = "z": BD(1) = 3: GOTO PASSMOVE
IF B$ = " " THEN MID$(a$(BX(1)), BY(1), 1) = " ": BY(1) = BY(1) - 1: MID$(a$(BX(1)), BY(1), 1) = "z": BD(1) = 2: GOTO PASSMOVE
IF D$ = " " THEN MID$(a$(BX(1)), BY(1), 1) = " ": BX(1) = BX(1) - 1: MID$(a$(BX(1)), BY(1), 1) = "z": BD(1) = 1: GOTO PASSMOVE
BD(1) = 4

CASE 3 'DOWN
B$ = MID$(a$(BX(1) + 1), BY(1), 1)
C$ = MID$(a$(BX(1)), BY(1) + 1, 1)
D$ = MID$(a$(BX(1)), BY(1) - 1, 1)
IF C$ = " " THEN MID$(a$(BX(1)), BY(1), 1) = " ": BY(1) = BY(1) + 1: MID$(a$(BX(1)), BY(1), 1) = "z": BD(1) = 4: GOTO PASSMOVE
IF B$ = " " THEN MID$(a$(BX(1)), BY(1), 1) = " ": BX(1) = BX(1) + 1: MID$(a$(BX(1)), BY(1), 1) = "z": BD(1) = 3: GOTO PASSMOVE
IF D$ = " " THEN MID$(a$(BX(1)), BY(1), 1) = " ": BY(1) = BY(1) - 1: MID$(a$(BX(1)), BY(1), 1) = "z": BD(1) = 2: GOTO PASSMOVE
BD(1) = 1

CASE 4 'RIGHT
B$ = MID$(a$(BX(1)), BY(1) + 1, 1)
C$ = MID$(a$(BX(1) - 1), BY(1), 1)
D$ = MID$(a$(BX(1) + 1), BY(1), 1)
IF C$ = " " THEN MID$(a$(BX(1)), BY(1), 1) = " ": BX(1) = BX(1) - 1: MID$(a$(BX(1)), BY(1), 1) = "z": BD(1) = 1: GOTO PASSMOVE
IF B$ = " " THEN MID$(a$(BX(1)), BY(1), 1) = " ": BY(1) = BY(1) + 1: MID$(a$(BX(1)), BY(1), 1) = "z": BD(1) = 4: GOTO PASSMOVE
IF D$ = " " THEN MID$(a$(BX(1)), BY(1), 1) = " ": BX(1) = BX(1) + 1: MID$(a$(BX(1)), BY(1), 1) = "z": BD(1) = 3: GOTO PASSMOVE
BD(1) = 2

PASSMOVE:
END SELECT
RETURN
FPS:
COLOR 4, 0
FOR J = 1 TO 9
FOR I = 1 TO 20
B$ = MID$(a$(J), I, 1)
SCREENMEM%(I, J) = VAL(B$)
LOCATE J, I: PRINT B$
NEXT I
NEXT J

COLOR 6
FOR I = 1 TO 9
FOR J = 1 TO 20
LOCATE I + 8, J + 10
B$ = MID$(a$(I), J, 1)
IF B$ = "w" THEN COLOR 6, 1: PRINT CHR$(WALL)
IF B$ = "." THEN COLOR 14, 4: PRINT "°"
IF B$ = "z" THEN COLOR 15, 0: PRINT CHR$(BUTTERFLY)
IF B$ = " " THEN COLOR 0, 0: PRINT CHR$(SPACE)
NEXT J
NEXT I
_DISPLAY
RETURN

this is my AI routine.. Not the smartest but works great.

6

QB64 Discussion / keyboard input (how do i read without repeat so it runs just like a joystick)

« on: July 05, 2019, 08:38:46 am »

hi below is my keyboard routine... it runs great but how can i run the same input without the keyboard repeat delay

i want to just press the keys and they will respond like a joystick... holding the key has a delay then repeat.

this is for my game i am making which so far feel really cool to play...

this is a remake of my digit (ASCII graphics boulder but written from complete scratch with multi color graphics and 8 frame animation.. just not ready yet to demo.. but is pretty cool

Code: QB64: [Select]

   KH& = _KEYHIT: SHFT% = _KEYDOWN(100303) OR _KEYDOWN(100304): ESC% = _KEYDOWN(27)
    IF KH& = -18432 THEN
        Z% = SCREENMEM%(MJ% - 1, MI%)
        IF Z% = DIRT THEN SCREENMEM%(MJ%, MI%) = SPACE: SCREENMEM%(MJ% - 1, MI%) = MAN: MJ% = MJ% - 1
        IF Z% = SPACE THEN SCREENMEM%(MJ%, MI%) = SPACE: SCREENMEM%(MJ% - 1, MI%) = MAN: MJ% = MJ% - 1
        IF Z% = DIAMOND THEN SCREENMEM%(MJ%, MI%) = SPACE: SCREENMEM%(MJ% - 1, MI%) = MAN: MJ% = MJ% - 1
        'UP
    END IF
    IF KH& = -20480 THEN
        Z% = SCREENMEM%(MJ% + 1, MI%)
        IF Z% = DIRT THEN SCREENMEM%(MJ%, MI%) = SPACE: SCREENMEM%(MJ% + 1, MI%) = MAN: MJ% = MJ% + 1
        IF Z% = SPACE THEN SCREENMEM%(MJ%, MI%) = SPACE: SCREENMEM%(MJ% + 1, MI%) = MAN: MJ% = MJ% + 1
        IF Z% = DIAMOND THEN SCREENMEM%(MJ%, MI%) = SPACE: SCREENMEM%(MJ% + 1, MI%) = MAN: MJ% = MJ% + 1
        'DOWN
    END IF
    IF KH& = -19200 AND SHFT% = -1 THEN
        Z1% = SCREENMEM%(MJ%, MI% - 1)
        Z2% = SCREENMEM%(MJ%, MI% + 1)
        IF Z1% = DIRT AND Z2% = BOULDER THEN SCREENMEM%(MJ%, MI% - 1) = MAN: SCREENMEM%(MJ%, MI%) = BOULDER: SCREENMEM%(MJ%, MI% + 1) = SPACE: MI% = MI% - 1: GOTO NEXTM
        IF Z1% = SPACE AND Z2% = BOULDER THEN SCREENMEM%(MJ%, MI% - 1) = MAN: SCREENMEM%(MJ%, MI%) = BOULDER: SCREENMEM%(MJ%, MI% + 1) = SPACE: MI% = MI% - 1: GOTO NEXTM
        IF Z1% = SPACE AND Z2% = DIAMOND THEN SCREENMEM%(MJ%, MI% - 1) = MAN: SCREENMEM%(MJ%, MI%) = DIAMOND: SCREENMEM%(MJ%, MI% + 1) = SPACE: MI% = MI% - 1: GOTO NEXTM
        GOTO NEXTM
        'LEFT SHIFT
    END IF
    IF KH& = -19200 THEN
        Z% = SCREENMEM%(MJ%, MI% - 1)
        IF Z% = DIRT THEN SCREENMEM%(MJ%, MI%) = SPACE: SCREENMEM%(MJ%, MI% - 1) = MAN: MI% = MI% - 1
        IF Z% = SPACE THEN SCREENMEM%(MJ%, MI%) = SPACE: SCREENMEM%(MJ%, MI% - 1) = MAN: MI% = MI% - 1: SCY1% = SCY1% - 1
        IF Z% = DIAMOND THEN SCREENMEM%(MJ%, MI%) = SPACE: SCREENMEM%(MJ%, MI% - 1) = MAN: MI% = MI% - 1
        IF Z% = BOULDER AND SCREENMEM%(MJ%, MI% - 2) = SPACE THEN SCREENMEM%(MJ%, MI% - 2) = BOULDER: SCREENMEM%(MJ%, MI% - 1) = MAN: SCREENMEM%(MJ%, MI%) = SPACE: MI% = MI% - 1
        'LEFT
    END IF
    IF KH& = -19712 AND SHFT% = -1 THEN
        Z1% = SCREENMEM%(MJ%, MI% + 1)
        Z2% = SCREENMEM%(MJ%, MI% - 1)
        IF Z1% = DIRT AND Z2% = BOULDER THEN SCREENMEM%(MJ%, MI% + 1) = MAN: SCREENMEM%(MJ%, MI%) = BOULDER: SCREENMEM%(MJ%, MI% - 1) = SPACE: MI% = MI% + 1: GOTO NEXTM
        IF Z1% = SPACE AND Z2% = BOULDER THEN SCREENMEM%(MJ%, MI% + 1) = MAN: SCREENMEM%(MJ%, MI%) = BOULDER: SCREENMEM%(MJ%, MI% - 1) = SPACE: MI% = MI% + 1: GOTO NEXTM
        IF Z1% = SPACE AND Z2% = DIAMOND THEN SCREENMEM%(MJ%, MI% + 1) = MAN: SCREENMEM%(MJ%, MI%) = DIAMOND: SCREENMEM%(MJ%, MI% - 1) = SPACE: MI% = MI% + 1: GOTO NEXTM
        GOTO NEXTM
        'RIGHT SHIFT
    END IF
 
    IF KH& = -19712 THEN
        Z% = SCREENMEM%(MJ%, MI% + 1)
        IF Z% = DIRT THEN SCREENMEM%(MJ%, MI%) = SPACE: SCREENMEM%(MJ%, MI% + 1) = MAN: MI% = MI% + 1
        IF Z% = SPACE THEN SCREENMEM%(MJ%, MI%) = SPACE: SCREENMEM%(MJ%, MI% + 1) = MAN: MI% = MI% + 1
        IF Z% = DIAMOND THEN SCREENMEM%(MJ%, MI%) = SPACE: SCREENMEM%(MJ%, MI% + 1) = MAN: MI% = MI% + 1
        IF Z% = BOULDER AND SCREENMEM%(MJ%, MI% + 2) = SPACE THEN SCREENMEM%(MJ%, MI% + 2) = BOULDER: SCREENMEM%(MJ%, MI% + 1) = MAN: SCREENMEM%(MJ%, MI%) = SPACE: MI% = MI% + 1
        'RIGHT
    END IF
    NEXTM:
LOOP UNTIL ESC% = -1

7

QB64 Discussion / [confusion cleared] [not really an error] timer error in qb64 1.3

« on: April 15, 2019, 09:03:06 pm »

when using _free timer i have found it disrupts my display

i find that printing to my screen works fine but then it jumps to a on timer. i print something else eg.locate 24,1:print "timer";tim:return and on return it continues printing but in the wrong spot

I wonder if the timer does not push the display co ordinates on the stack and pop them off on return to continue where left off....

eg. push x,y screen location
jsr timer (on gosub timer)
pop x,y
ret (end)

timer:
locate x,y
print "what ever where even"
ret (return from timer)

this what doing
xxxxxxxxxxxxxxxxxdxxxxx
xhellxxxxxxxxxxxxxxxxxxx
xxxxxxxxxo worlxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxx

this what should be
xxxxxxxxxxxxxxxxxxxxxxx
xhello worldxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxx

its like it forgets the x,y on return

8

QB64 Discussion / gl shaders in text mode...

« on: April 15, 2019, 08:27:42 pm »

how would i use gl... would like to use a simple shadder to put light on screen on dark images (torch light) as in circle (100,100),10,light

i do not know where to start or how to implement

like a dungeon with a torch light on

9

Programs / PUZZLE GAME / FREE - WRITTEN BY ME.. ORIGINAL CODE

« on: April 13, 2019, 09:13:20 am »

linux *** just copy to a folder (eg.gamesquare) and unzip the data directory as data.. change to make executable

other just compile the bas file and put data in a data directory

Input to move the characters is by

* keyboard (num pad 4 8 6 1
* mouse / hold button if you dont want to keep clicking and drag

simple puzzle.... code is probably a bit long but work good. have fun

10

QB64 Discussion / graphics mode (pset, put, _putimage)

« on: January 23, 2019, 03:28:22 am »

hey guys... i am making a game in graphics mode but seem to be having problems with the pset (and put)

HOW DO I MAKE THESE SOLID... NO ALPHA BUT SEE THROUGH...

i want the rings solid but see the background... (solid rings on back ground..

DIM TILE0(1 TO 5000), TILE1(1 TO 5000), TILE2(1 TO 5000): GLB& = _LOADIMAGE("PYRAMID.jpg", 32)
SCREEN _NEWIMAGE(1280, 680, 32)
FOR I = 1 TO 32: READ A$: FOR J = 1 TO 63: A = VAL(MID$(A$, J, 1))
IF A = 1 THEN PSET (J, I), _RGB(0, 0, 128, 255): PSET (J, 65 - I), _RGB(0, 0, 128, 255)
IF A = 0 THEN PSET (J, I), _RGB(&HFF, &HFF, &HFF): PSET (J, 65 - I), _RGB(&H00, &H00, &H00)
NEXT: NEXT: GET (1, 1)-(64, 64), TILE0(): RESTORE
FOR I = 1 TO 32: READ A$: FOR J = 1 TO 63: A = VAL(MID$(A$, J, 1))
IF A = 1 THEN PSET (J, I), _RGB(128, 0, 0): PSET (J, 65 - I), _RGB(128, 0, 0)
IF A = 0 THEN PSET (J, I), _RGB(&HFF, &HFF, &HFF): PSET (J, 65 - I), _RGB(&HFF, &HFF, &HFF)
NEXT: NEXT: GET (1, 1)-(64, 64), TILE1(): RESTORE
FOR I = 1 TO 32: READ A$: FOR J = 1 TO 63: A = VAL(MID$(A$, J, 1))
IF A = 1 THEN PSET (J, I), _RGB(0, 128, 0): PSET (J, 65 - I), _RGB(0, 128, 0)
IF A = 0 THEN PSET (J, I), _RGB(&HFF, &HFF, &HFF): PSET (J, 65 - I), _RGB(&HFF, &HFF, &HFF)
NEXT: NEXT: GET (1, 1)-(64, 64), TILE2()

CLS
_PUTIMAGE , GLB&
PUT (1, 1), TILE0()
PUT (32, 32), TILE1()
PUT (64, 64), TILE2()

DATA "000000000000000000000000000111111110000000000000000000000000000"
DATA "000000000000000000000011111111111111111110000000000000000000000"
DATA "000000000000000000011111111111111111111111110000000000000000000"
DATA "000000000000000001111111111111111111111111111100000000000000000"
DATA "000000000000000111111111111111111111111111111111000000000000000"
DATA "000000000000011111111111111111111111111111111111110000000000000"
DATA "000000000000111111111111111111111111111111111111111000000000000"
DATA "000000000001111111111111111111111111111111111111111100000000000"
DATA "000000000011111111111111111111111111111111111111111110000000000"
DATA "000000000111111111111111111111111111111111111111111111000000000"
DATA "000000001111111111111111111111111111111111111111111111100000000"
DATA "000000011111111111111111111111111111111111111111111111110000000"
DATA "000000111111111111111111111111111111111111111111111111111000000"
DATA "000001111111111111111111111111111111111111111111111111111100000"
DATA "000011111111111111111111111111111111111111111111111111111100000"
DATA "000011111111111111111111111111111111111111111111111111111110000"
DATA "000111111111111111111111111111111111111111111111111111111111000"
DATA "000111111111111111111111111111111111111111111111111111111111000"
DATA "001111111111111111111111111111111111111111111111111111111111100"
DATA "001111111111111111111111111111111111111111111111111111111111100"
DATA "001111111111111111111111111111111111111111111111111111111111100"
DATA "011111111111111111111111111111111111111111111111111111111111110"
DATA "011111111111111111111111111111111111111111111111111111111111110"
DATA "011111111111111111111111111110000011111111111111111111111111110"
DATA "011111111111111111111111111000000000111111111111111111111111110"
DATA "011111111111111111111111110000000000011111111111111111111111110"
DATA "111111111111111111111111100000000000001111111111111111111111111"
DATA "111111111111111111111111000000000000000111111111111111111111111"
DATA "111111111111111111111111000000000000000111111111111111111111111"
DATA "111111111111111111111110000000000000000011111111111111111111111"
DATA "111111111111111111111110000000000000000011111111111111111111111"
DATA "111111111111111111111110000000000000000011111111111111111111111"

11

Programs / PUZZLE GAME / FREE - WRITTEN BY ME.. ORIGINAL CODE

« on: January 20, 2019, 06:33:46 am »

dOWNLOAD THE ZIP FILE... cONTAINS BOTH TEXT AND GRAPHIC VERSION.. (GRAPHIC HAS SOUND AND MUSIC)

USE NUMBER PAD TO MOVE (8 = UP 2 = DOWN 4 = LEFT AND 6 = RIGHT

THIS GAME ONLY SWAPS THE LETTERS IN THE STRING FROM A-G... 3 X 3 MATRIX

HOPE ITS OK... NOTHING FANCY JUST REMEMBER PLAYING THIS ON A MICROBEE 128K PREMIUM WITH HARDDISK... SO HAD TO MAKE MY OWN..

' *******************************************************
'
' ****************
' aLPHABET PUZZLE
' ****************
' wRITTEN bY Paul Mackay
' May or May not work / this is how my brain sees LOGIC
' Wednesday 2,2019 Text Only / No move counter, No sound
' *******************************************************
_TITLE "aLPHABET PUZZLE": RANDOMIZE VAL(RIGHT$(TIME$, 2)): S& = _SNDOPEN(".\data\tick.mp3"): GL& = _SNDOPEN(".\data\ingame.ogg"): _SNDVOL S&, 1: A& = _LOADIMAGE(".\data\a.jpg", 32): B& = _LOADIMAGE(".\data\b.jpg", 32): C& = _LOADIMAGE(".\data\c.jpg", 32): D& = _LOADIMAGE(".\data\d.jpg", 32): E& = _LOADIMAGE(".\data\e.jpg", 32): F& = _LOADIMAGE(".\data\f.jpg", 32): G& = _LOADIMAGE(".\data\g.jpg", 32): H& = _LOADIMAGE(".\data\h.jpg", 32): I& = _LOADIMAGE(".\data\i.jpg", 32): SCREEN _NEWIMAGE(264, 281, 32): _DISPLAY: SQUARE$ = "123456789": GOSUB RANDOMSTART
_SNDLOOP GL&
START: GOSUB SHOWSQUARES: GOSUB KEYINPUT: IF SQUARE$ = "123456789" THEN GOSUB SHOWSQUARES: END ELSE GOTO START
SHOWSQUARES: FOR I = 1 TO 9: CURRENT$ = MID$(SQUARE$, I, 1): CURRENT = VAL(CURRENT$): SELECT CASE I: CASE 1: X = 1: Y = 1: CASE 2: X = 88: Y = 1: CASE 3: X = 175: Y = 1: CASE 4: X = 1: Y = 95: CASE 5: X = 88: Y = 95: CASE 6: X = 175: Y = 95: CASE 7: X = 1: Y = 189: CASE 8: X = 88: Y = 189: CASE 9: X = 175: Y = 189: END SELECT: GOSUB DISPSHOW: NEXT I: _DISPLAY: RETURN
SWAPPED: SWAP SW2$, SW1$: _SNDPLAYCOPY S&, 1: RETURN
OVER: _SNDSTOP GL&: _FREEIMAGE A&: _FREEIMAGE B&: _FREEIMAGE C&: _FREEIMAGE D&: _FREEIMAGE E&: _FREEIMAGE F&: _FREEIMAGE G&: _FREEIMAGE H&: _FREEIMAGE I&: END
DISPSHOW: SELECT CASE CURRENT: CASE 1: _PUTIMAGE (X, Y), A&: CASE 2: _PUTIMAGE (X, Y), B&: CASE 3: _PUTIMAGE (X, Y), C&: CASE 4: _PUTIMAGE (X, Y), D&: CASE 5: _PUTIMAGE (X, Y), E&: CASE 6: _PUTIMAGE (X, Y), F&: CASE 7: _PUTIMAGE (X, Y), G&: CASE 8: _PUTIMAGE (X, Y), H&: CASE 9: _PUTIMAGE (X, Y), I&: END SELECT: RETURN
RANDOMSTART: S1$ = "": FOR I = 1 TO 9: DO: X = INT(RND(1) * 9) + 1: IF MID$(SQUARE$, X, 1) <> "0" THEN S1$ = S1$ + MID$(SQUARE$, X, 1): MID$(SQUARE$, X, 1) = "0" ELSE IF SQUARE$ = "000000000" THEN EXIT DO
LOOP: NEXT I: SQUARE$ = S1$: RETURN
KEYINPUT: I$ = INKEY$: IF I$ = "" THEN GOTO KEYINPUT ELSE IF I$ = "+" THEN SQUARE$ = "123456789": GOSUB RANDOMSTART: RETURN
Z = 1: DO: IF MID$(SQUARE$, Z, 1) = "9" THEN EXIT DO ELSE Z = Z + 1
LOOP: SELECT CASE Z
CASE 1: IF I$ = "8" THEN SW1$ = MID$(SQUARE$, 1, 1): SW2$ = MID$(SQUARE$, 4, 1): GOSUB SWAPPED: MID$(SQUARE$, 1, 1) = SW1$: MID$(SQUARE$, 4, 1) = SW2$ ELSE IF I$ = "4" THEN SW1$ = MID$(SQUARE$, 1, 1): SW2$ = MID$(SQUARE$, 2, 1): GOSUB SWAPPED: MID$(SQUARE$, 1, 1) = SW1$: MID$(SQUARE$, 2, 1) = SW2$
CASE 2: IF I$ = "8" THEN SW1$ = MID$(SQUARE$, 2, 1): SW2$ = MID$(SQUARE$, 5, 1): GOSUB SWAPPED: MID$(SQUARE$, 2, 1) = SW1$: MID$(SQUARE$, 5, 1) = SW2$ ELSE IF I$ = "4" THEN SW1$ = MID$(SQUARE$, 2, 1): SW2$ = MID$(SQUARE$, 3, 1): GOSUB SWAPPED: MID$(SQUARE$, 2, 1) = SW1$: MID$(SQUARE$, 3, 1) = SW2$ ELSE IF I$ = "6" THEN SW1$ = MID$(SQUARE$, 2, 1): SW2$ = MID$(SQUARE$, 1, 1): GOSUB SWAPPED: MID$(SQUARE$, 2, 1) = SW1$: MID$(SQUARE$, 1, 1) = SW2$
CASE 3: IF I$ = "6" THEN SW1$ = MID$(SQUARE$, 3, 1): SW2$ = MID$(SQUARE$, 2, 1): GOSUB SWAPPED: MID$(SQUARE$, 3, 1) = SW1$: MID$(SQUARE$, 2, 1) = SW2$ ELSE IF I$ = "8" THEN SW1$ = MID$(SQUARE$, 3, 1): SW2$ = MID$(SQUARE$, 6, 1): GOSUB SWAPPED: MID$(SQUARE$, 3, 1) = SW1$: MID$(SQUARE$, 6, 1) = SW2$
CASE 4: IF I$ = "2" THEN SW1$ = MID$(SQUARE$, 4, 1): SW2$ = MID$(SQUARE$, 1, 1): GOSUB SWAPPED: MID$(SQUARE$, 4, 1) = SW1$: MID$(SQUARE$, 1, 1) = SW2$ ELSE IF I$ = "4" THEN SW1$ = MID$(SQUARE$, 5, 1): SW2$ = MID$(SQUARE$, 4, 1): GOSUB SWAPPED: MID$(SQUARE$, 5, 1) = SW1$: MID$(SQUARE$, 4, 1) = SW2$ ELSE IF I$ = "8" THEN SW1$ = MID$(SQUARE$, 4, 1): SW2$ = MID$(SQUARE$, 7, 1): GOSUB SWAPPED: MID$(SQUARE$, 4, 1) = SW1$: MID$(SQUARE$, 7, 1) = SW2$
CASE 5: IF I$ = "2" THEN SW1$ = MID$(SQUARE$, 5, 1): SW2$ = MID$(SQUARE$, 2, 1): GOSUB SWAPPED: MID$(SQUARE$, 5, 1) = SW1$: MID$(SQUARE$, 2, 1) = SW2$ ELSE IF I$ = "4" THEN SW1$ = MID$(SQUARE$, 5, 1): SW2$ = MID$(SQUARE$, 6, 1): GOSUB SWAPPED: MID$(SQUARE$, 5, 1) = SW1$: MID$(SQUARE$, 6, 1) = SW2$ ELSE IF I$ = "6" THEN SW1$ = MID$(SQUARE$, 5, 1): SW2$ = MID$(SQUARE$, 4, 1): GOSUB SWAPPED: MID$(SQUARE$, 5, 1) = SW1$: MID$(SQUARE$, 4, 1) = SW2$ ELSE IF I$ = "8" THEN SW1$ = MID$(SQUARE$, 5, 1): SW2$ = MID$(SQUARE$, 8, 1): GOSUB SWAPPED: MID$(SQUARE$, 5, 1) = SW1$: MID$(SQUARE$, 8, 1) = SW2$
CASE 6: IF I$ = "2" THEN SW1$ = MID$(SQUARE$, 6, 1): SW2$ = MID$(SQUARE$, 3, 1): GOSUB SWAPPED: MID$(SQUARE$, 6, 1) = SW1$: MID$(SQUARE$, 3, 1) = SW2$ ELSE IF I$ = "6" THEN SW1$ = MID$(SQUARE$, 6, 1): SW2$ = MID$(SQUARE$, 5, 1): GOSUB SWAPPED: MID$(SQUARE$, 6, 1) = SW1$: MID$(SQUARE$, 5, 1) = SW2$ ELSE IF I$ = "8" THEN SW1$ = MID$(SQUARE$, 6, 1): SW2$ = MID$(SQUARE$, 9, 1): GOSUB SWAPPED: MID$(SQUARE$, 6, 1) = SW1$: MID$(SQUARE$, 9, 1) = SW2$
CASE 7: IF I$ = "2" THEN SW1$ = MID$(SQUARE$, 7, 1): SW2$ = MID$(SQUARE$, 4, 1): GOSUB SWAPPED: MID$(SQUARE$, 7, 1) = SW1$: MID$(SQUARE$, 4, 1) = SW2$ ELSE IF I$ = "4" THEN SW1$ = MID$(SQUARE$, 7, 1): SW2$ = MID$(SQUARE$, 8, 1): GOSUB SWAPPED: MID$(SQUARE$, 7, 1) = SW1$: MID$(SQUARE$, 8, 1) = SW2$
CASE 8: IF I$ = "2" THEN SW1$ = MID$(SQUARE$, 8, 1): SW2$ = MID$(SQUARE$, 5, 1): GOSUB SWAPPED: MID$(SQUARE$, 8, 1) = SW1$: MID$(SQUARE$, 5, 1) = SW2$ ELSE IF I$ = "4" THEN SW1$ = MID$(SQUARE$, 8, 1): SW2$ = MID$(SQUARE$, 9, 1): GOSUB SWAPPED: MID$(SQUARE$, 8, 1) = SW1$: MID$(SQUARE$, 9, 1) = SW2$ ELSE IF I$ = "6" THEN SW1$ = MID$(SQUARE$, 8, 1): SW2$ = MID$(SQUARE$, 7, 1): GOSUB SWAPPED: MID$(SQUARE$, 8, 1) = SW1$: MID$(SQUARE$, 7, 1) = SW2$
CASE 9: IF I$ = "2" THEN SW1$ = MID$(SQUARE$, 9, 1): SW2$ = MID$(SQUARE$, 6, 1): GOSUB SWAPPED: MID$(SQUARE$, 9, 1) = SW1$: MID$(SQUARE$, 6, 1) = SW2$ ELSE IF I$ = "6" THEN SW1$ = MID$(SQUARE$, 9, 1): SW2$ = MID$(SQUARE$, 8, 1): GOSUB SWAPPED: MID$(SQUARE$, 9, 1) = SW1$: MID$(SQUARE$, 8, 1) = SW2$
END SELECT: RETURN

12

Programs / super simple sprite routine (16x16 chars easy to modify)

« on: October 13, 2018, 03:12:10 am »

I wanted something different to play with, so i played with pset

this is my simple sprite routine to display 8 sprites

at 16x16 (easy to change)

sprites priority's are 1 at the back to 8 at the front.. first four behind text and last four in front of text.

its easy to change the amount

I like my x set for 3 and y for 0.7

do as you will to it... i was just bored and trying stuff out.

you might want to vacuum the code, its a bit messy

13

QB64 Discussion / qb64 ide autosave error / keeps crashing at random (IDE error)

« on: October 02, 2018, 05:15:44 am »

Hi how can i piss off the IDE autosave, it crashes when asks if i want to recover program. then when i return i have lost half my work. it goes back to autosaved.. this is third time crashed today.

14

QB64 Discussion / QB64 exit... crash maybe or error

« on: September 30, 2018, 06:29:12 am »

I used a

DIM VFLIP&
_SNDOPEN ("FLIPV.OGG)
_SNDVOL VFLIP&,1

MY QB64 EXITS WITH "Press any key to continue" then Exits qb64

Is vflip& an internal var... (I had change to a different file .ogg to which it also does the same

changing vflip& to flipit& fixed the problem.. but not sure why it exits with vflip&

15

Programs / ASCII title from my game Faceblock

« on: September 28, 2018, 10:42:48 pm »

T thought I would upload my title in case anyone wants to see it NAKED (raw, no user defined characters, no sound, no new colour pallets) includes how I made my time bar

News:

Topics - PMACKAY

Programs / ascII almost smooth pixel scroll

QB64 Discussion / play command on linux doing weird thing on qb64 1.15

Programs / boulderdash update pmackay

Programs / Boulderdash

QB64 Discussion / BoulderDash butterfly movement (AI).. QB64 pmackay

QB64 Discussion / keyboard input (how do i read without repeat so it runs just like a joystick)

QB64 Discussion / [confusion cleared] [not really an error] timer error in qb64 1.3

QB64 Discussion / gl shaders in text mode...

Programs / PUZZLE GAME / FREE - WRITTEN BY ME.. ORIGINAL CODE

QB64 Discussion / graphics mode (pset, put, _putimage)

Programs / PUZZLE GAME / FREE - WRITTEN BY ME.. ORIGINAL CODE

Programs / super simple sprite routine (16x16 chars easy to modify)

QB64 Discussion / qb64 ide autosave error / keeps crashing at random (IDE error)

QB64 Discussion / QB64 exit... crash maybe or error

Programs / ASCII title from my game Faceblock