Because I have little control over what my brain or heart finds interesting I became curious how many words can be made by replacing tr in a word with an f, just no accounting for what we humans will get into!
I was thinking about writing a little poem, haiku.... something with clever substitutions of tr with f.
So wouldn't it be helpful to have a double list of real words you can substitute tr with f.
I had a Collins_Word_List.RA file already used for checking for real words in Boggle or other Word Play apps so lets make a list of real words made by replacing tr's with f's
Code: (Select All)
'2023-06-29 took over an hour to get debugged
Dim tr$(1 To 100000), f$(1 To 100000)
Dim As Long trI, fI, i
Dim buf$, wd$
Dim Shared rec15 As String * 15
Dim Shared NTopWord As Long
Dim Shared n$
nl$ = Chr$(13) + Chr$(10) ' eh too much work here for little joke
Open "Collins_Word_List.RA" For Random As #1 Len = 15
NTopWord = LOF(1) / 15
For i = 1 To NTopWord
Get #1, i, rec15
wd$ = _Trim$(rec15)
If InStr(wd$, "TR") Then trI = trI + 1: tr$(trI) = wd$
Next
Open "tr to f.txt" For Output As #2
For i = 1 To trI
wd$ = strReplace$(tr$(i), "TR", "F")
If Find&(wd$) Then
Print tr$(i), wd$
Print #2, tr$(i), wd$
End If
Next
Close
Function Find& (x$) ' if I am using this only to find words in dictionary, I can mod to optimize
' the RA file is opened and ready for gets
Dim As Long low, hi, test
Dim w$
If Len(x$) < 2 Then Exit Function ' words need to be 3 letters
low = 1: hi = NTopWord
While low <= hi
test = Int((low + hi) / 2)
Get #1, test, rec15
w$ = _Trim$(rec15)
If w$ = x$ Then
Find& = test: Exit Function
Else
If w$ < x$ Then low = test + 1 Else hi = test - 1
End If
Wend
End Function
Function strReplace$ (s$, replace$, new$) 'case sensitive 2020-07-28 version
Dim p As Long, sCopy$, LR As Long, lNew As Long
If Len(s$) = 0 Or Len(replace$) = 0 Then
strReplace$ = s$: Exit Function
Else
LR = Len(replace$): lNew = Len(new$)
End If
sCopy$ = s$ ' otherwise s$ would get changed
p = InStr(sCopy$, replace$)
While p
sCopy$ = Mid$(sCopy$, 1, p - 1) + new$ + Mid$(sCopy$, p + LR)
p = InStr(p + lNew, sCopy$, replace$)
Wend
strReplace$ = sCopy$
End Function
Output in zip and RA (Random Access Dictionary). The RA file requires a String * 15 long record variable to do word lookups without having to load the whole file into an array.
I wonder if @TDarcos or anyone (I offer rep points!) would care to finish this thread with some cute conversion of tr words to f words
see "tr to f.txt" file in zip
Update: Download zip extracted and checked for proper "tr to f.txt" file, yep! OK 253 words but you either know the tr word or the f word but only rarely know both! So it will take a mind wackier than mine (maybe) to compose a cute little saying.
Hey! what a great way to kick off the Summer of Fun with a new banner and a little challenge!
I was looking for drop menus code and Search directed me to Chapter 20:
Quote:Lesson20 ... game; A button library to create Windows style clickable buttons on screen, a menu library to create Windows style drop down menus, and graphics ... Last modified on May 7, 2023
Looked like just what I wanted to see but I read through Ch 20 found a Collision Library building example and an API thing but nothing on Drop Menus and clickable buttons.
Is this an omission or misdirection (another Chapter has these things)?
_Title "Plasma Snake - any key to change color" 'b+ 2023-06-27
' inspired once again by Paul Dunn aka ZXDunny here:
' https://retrocoders.phatcode.net/index.php?topic=634.0
' and my mod? hopefully I can do same or similar PLUS allow you to change plasma schemes!
' Plus put a face on it!
' lets see!
Screen _NewImage(800, 600, 32) ' 32 = all colors of _RGBA32() = millions!
_ScreenMove 250, 60 ' you may want different
Randomize Timer ' + so we start different each time, who wants to see same old snake?
Dim Shared PR, PG, PB, CN ' for setup and changing Plasma Color Schemes
PR = Rnd ^ 2: PG = Rnd ^ 2: PB = Rnd ^ 2 ' setup one to start
da = 1: r = 60
Do
CN = 0 ' reset plasma index to 0 for consistent color bands
For x = r To 800 - r ' make a snake body
CN = CN + .5
Color _RGB32(127 + 127 * Sin(PR * CN), 127 + 127 * Sin(PG * CN), 127 + 127 * Sin(PB * CN))
FCirc x, 300 + (300 - r) * Sin(_D2R(x + a)), r, _DefaultColor
Next
' Put a face on it!
x = x - 1
y = 300 + (300 - r) * Sin(_D2R(x + a))
' eyes
FCirc x - .625 * r, y - .1 * r, .125 * r, &HFF000000
FCirc x + .625 * r, y - .1 * r, .125 * r, &HFF000000
Circle (x - .62 * r, y - .1 * r), .1 * r, &HFFFFFFFF
Circle (x + .62 * r, y - .1 * r), .1 * r, &HFFFFFFFF
' nose
FCirc x - .1 * r, y + .35 * r, .025 * r, &HFF000000
FCirc x + .1 * r, y + .35 * r, .025 * r, &HFF000000
' mouth
Line (x - 4, y + .65 * r)-(x + 4, y + .655 * r), &HFFFF0000, BF
' and a little tongue of course
If m Mod 20 = 0 Then ' flash every 10 loops
Line (x - 2, y + .655 * r)-(x + 2, y + .9 * r), &HFFFF0000, BF
Line (x - 2, y + .9 * r)-(x - .08 * r, y + r), &HFFFF0000
Line (x + 2, y + .9 * r)-(x + .08 * r, y + r), &HFFFF0000
End If
_Display
If m Mod 20 = 0 Then ' erase the tongue flash every 10 loops
Line (x - 2, y + .655 * r)-(x + 2, y + .9 * r), _DefaultColor, BF
Line (x - 2, y + .9 * r)-(x - .08 * r, y + r), _DefaultColor
Line (x + 2, y + .9 * r)-(x + .08 * r, y + r), _DefaultColor
End If
m = m + 1
a = a + da
If Len(InKey$) Then PR = Rnd ^ 2: PG = Rnd ^ 2: PB = Rnd ^ 2
Loop Until _KeyDown(27)
Sub FCirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
I have the few lines of code below, which draw a shape on the screen.
How do I implement a "Paint" (or P in a draw-string) to paint the inside of the shape, say red (_RGB(255,0,0) ?
EDIT: The program loops through various scrolling scenarios, incrementing the number of pixels scrolled by 1 every iteration of the loop. Each scroll scenario performs the scroll 20 times. All in fairly slow speed to give an opportunity to see positions of a pixel before and after a scroll statement.
Arguably one of the more frustrating games ever released for the NES, I started this project to try and fix some of the issues I have with the game, mainly the collision detection. You get stuck in the game a lot.
I have done some testing on my own but would like to see if anybody else can break anything or if there are spots where you seem to get 'stuck' or have trouble with the character not moving. Mainly to see if the collision detection can be broken anywhere. I have 1 dungeon loading the start location and exit location are the same as the NES version so you can use this map to navigate it. https://gamefaqs.gamespot.com/nes/587219...aze-01-map
there are no shops yet or anything its just map exploring.
keys are:
Arrow keys move
Spacebar brings up status screen
'a' uses item in status screen (lower case)
'b' drops item in status screen (lower case)
also exits game when out of status screen
Download the attached MFI file
Code: (Select All)
'Deadly Tower clone beta test release
'date code: 06252023
'Cobalt
TYPE Control_Keys
Up_Key AS LONG
Down_Key AS LONG
Left_Key AS LONG
Right_Key AS LONG
A_Button AS LONG
B_Button AS LONG
Select_Button AS LONG
Start_Button AS LONG
END TYPE
TYPE MapData
x AS INTEGER
y AS INTEGER
MaxScroll AS INTEGER
Scroll AS _BYTE
END TYPE
TYPE Corddata
X AS INTEGER
Y AS INTEGER
END TYPE
TYPE Gamedata
Map AS Corddata 'scroll value of map 0 to MaxScroll
Scroll_Direction AS _BYTE 'which direction does map scroll, vert or horiz
Passage AS _BYTE 'has player entered a doorway of somekind?
Dungeon AS _BYTE 'has player entered a dungeon?
Dungeon_Shop_Count AS _BYTE
Exit_Dungeon AS _BYTE ' works like passage, puts player on overworld at dungeon exit passage
Last_Dungeon AS _BYTE
Shop_Count AS _BYTE
Where AS _BYTE ' where the doorway leads
Door_Side AS _BYTE 'denote which door player went through in dungeon
Shop AS _BYTE 'which shop is player entering
FallDeath AS _BYTE
Scroll_Lock AS _BYTE 'turn scrolling on or off on level
On_Ladder AS _BYTE 'is player currently climbing a ladder
Duration AS _BYTE 'if player used blue or green necklace, how long it lasts
PauseEnemies AS _BYTE 'if player uses the figure pause all for
Duration
(affects all enemies not just humaniod ones as in original)
END TYPE
TYPE PlayerData
Health AS _UNSIGNED _BYTE
MaxHealth AS _UNSIGNED _BYTE
Ludder AS _UNSIGNED _BYTE
Bells AS _BYTE 'bells player has
Burned AS _BYTE 'bells burned
Helm AS _BYTE
Shield AS _BYTE
Armor AS _BYTE
Sword AS _BYTE
Enhance AS _BYTE
Glove AS _BYTE
Boots AS _BYTE
O_Necklace AS _BYTE
DefBonus AS _BYTE 'bonus to defence by blue or green necklaces
X AS INTEGER 'player screen location
Y AS INTEGER
DX AS _BYTE 'player location in Dungeon
DY AS _BYTE 'player location in dungeon
Level AS _BYTE
Direction AS _BYTE
Action AS _BYTE
END TYPE
TYPE Passage_Data
Level AS _BYTE
P AS Corddata
M AS Corddata
Scrolling AS _BYTE 'horizontal,vertical, locked
END TYPE
TYPE Item_Data
Name AS STRING * 14
x AS INTEGER
y AS INTEGER
power AS _BYTE
defen AS _BYTE
Heal AS _UNSIGNED _BYTE
effct AS _BYTE
END TYPE
TYPE Dungeon_Data
N AS _BYTE
E AS _BYTE
W AS _BYTE
S AS _BYTE
Doorways AS _BYTE
Layout AS _UNSIGNED INTEGER '4bit wall\door color, 3 bit floor color, 1 bit windows, 1 bit columns,3bit floor mural ,4bit is exit or shop,
Torch AS _BYTE
Monster_Group AS _BYTE
END TYPE
TYPE Dungeon_Extra
StartRoom AS _BYTE 'which room does player start in.
ExitRoom AS _BYTE 'Which room is exit.
Shop_Count AS _BYTE 'number of shops in dungeon
END TYPE
CONST TRUE = -1, FALSE = NOT TRUE, LOCKED = TRUE, Horizontal = 0, Vertical = 1
CONST UP = 0, DOWN = 4, LEFT = 6, RIGHT = 2
CONST UP_LEFT = 7, UP_RIGHT = 1, DOWN_LEFT = 5, DOWN_RIGHT = 3
CONST Moving = 1, Standing = 0, Climbing = 2
'map bounds collision and door way collision
CONST Collide_White = _RGB32(255), Collide_Blue = _RGB32(0, 0, 255)
DIM SHARED Layer(16) AS LONG, Control AS Control_Keys
DIM SHARED P AS PlayerData, Pack(9) AS _BYTE, Map(33) AS MapData, G AS Gamedata
DIM SHARED D(84) AS Passage_Data, I(64) AS Item_Data
DIM SHARED Dungeon(10, 15, 15) AS Dungeon_Data, DE(10) AS Dungeon_Extra
'_PRINTSTRING (160, 0), "Timer Seed" + STR$(t!), Layer(0)
'END
Passage 0 'start game here
DO
KB~%% = Controls
IF _READBIT(KB~%%, 0) THEN P.Action = Moving: P.Direction = UP 'player pressed up arrow
IF _READBIT(KB~%%, 1) THEN P.Action = Moving: P.Direction = DOWN 'player pressed down arrow
IF _READBIT(KB~%%, 2) THEN P.Action = Moving: P.Direction = LEFT 'player pressed left arrow
IF _READBIT(KB~%%, 3) THEN P.Action = Moving: P.Direction = RIGHT 'player pressed right arrow
IF _READBIT(KB~%%, 0) AND _READBIT(KB~%%, 2) THEN P.Action = Moving: P.Direction = UP_LEFT 'player pressed up arrow
IF _READBIT(KB~%%, 0) AND _READBIT(KB~%%, 3) THEN P.Action = Moving: P.Direction = UP_RIGHT 'player pressed down arrow
IF _READBIT(KB~%%, 1) AND _READBIT(KB~%%, 2) THEN P.Action = Moving: P.Direction = DOWN_LEFT 'player pressed left arrow
IF _READBIT(KB~%%, 1) AND _READBIT(KB~%%, 3) THEN P.Action = Moving: P.Direction = DOWN_RIGHT 'player pressed right arrow
IF _READBIT(KB~%%, 4) THEN Status_screen
IF _READBIT(KB~%%, 5) THEN Pause_Game
IF _READBIT(KB~%%, 7) THEN ExitFlag%% = -1
IF _SHL(KB~%%, 4) = FALSE THEN P.Action = Standing 'if no direction key press then stop moving
IF P.Action <> Standing THEN Move_Player
IF G.Passage THEN Passage G.Where
IF G.FallDeath THEN Fall_Death
IF G.Dungeon THEN EnterDungeon G.Dungeon 'big deal code wise! whole seperate main loop
SUB EnterDungeon (ID%%)
OPEN "debug.txt" FOR OUTPUT AS #1 'save dungeon room layouts incase of issue
Fade_Out Layer(0)
P.X = 242
P.Y = 288
P.Level = ID%% 'level = the dungeon player is in
P.DX = VAL("&H" + LEFT$(HEX$(DE(P.Level).StartRoom), 1)) 'High 4 bits room X loc
P.DY = DE(ID%%).StartRoom AND 15 'Low 4 bits room Y loc
IF G.Dungeon <> G.Last_Dungeon THEN 'don't recreate dungeon if player just left it(save 3.5s)
ClearLayer Layer(3)
ClearLayer Layer(4)
COLOR _RGB32(64)
FOR y%% = 0 TO 15
FOR x%% = 0 TO 15
ClearLayer Layer(1)
Draw_Dungeon x%%, y%%
percent%% = INT(count% / 256 * 100)
_PRINTSTRING (212, 232), "Loading Dungeon..." + LTRIM$(STR$(percent%%)) + "%", Layer(0)
count% = count% + 1
NEXT x%%, y%%
G.Last_Dungeon = G.Dungeon
END IF
DO
KB~%% = Controls
IF _READBIT(KB~%%, 0) THEN P.Action = Moving: P.Direction = UP 'player pressed up arrow
IF _READBIT(KB~%%, 1) THEN P.Action = Moving: P.Direction = DOWN 'player pressed down arrow
IF _READBIT(KB~%%, 2) THEN P.Action = Moving: P.Direction = LEFT 'player pressed left arrow
IF _READBIT(KB~%%, 3) THEN P.Action = Moving: P.Direction = RIGHT 'player pressed right arrow
IF _READBIT(KB~%%, 0) AND _READBIT(KB~%%, 2) THEN P.Action = Moving: P.Direction = UP_LEFT 'player pressed up arrow
IF _READBIT(KB~%%, 0) AND _READBIT(KB~%%, 3) THEN P.Action = Moving: P.Direction = UP_RIGHT 'player pressed down arrow
IF _READBIT(KB~%%, 1) AND _READBIT(KB~%%, 2) THEN P.Action = Moving: P.Direction = DOWN_LEFT 'player pressed left arrow
IF _READBIT(KB~%%, 1) AND _READBIT(KB~%%, 3) THEN P.Action = Moving: P.Direction = DOWN_RIGHT 'player pressed right arrow
IF _READBIT(KB~%%, 4) THEN Status_screen
IF _READBIT(KB~%%, 5) THEN Pause_Game
IF _READBIT(KB~%%, 7) THEN ExitFlag%% = -1
IF _SHL(KB~%%, 4) = FALSE THEN P.Action = Standing 'if no direction key press then stop moving
IF P.Action <> Standing THEN Move_Player
IF G.Passage THEN Dungeon_Passage G.Where
' IF G.Dungeon THEN Passage G.Dungeon 'exit back to overworld
IF G.Exit_Dungeon THEN Passage G.Exit_Dungeon: ExitFlag%% = TRUE: G.Exit_Dungeon = FALSE
' IF G.Shop THEN Run_Shop G.Shop
SUB Create_Dungeon_Layout (X%%, Y%%)
'setup a layout for this room if not set
colors%% = INT(RND * 15) + 1 'wall and door colors
floor%% = INT(RND * 6) + 1 'floor color
windows%% = INT(RND * 1) 'window flag
columns%% = INT(RND * 1) 'column flag
IF INT(RND * 255) > 245 THEN Murals%% = INT(RND * 5) + 1 'is there a mural?
IF G.Shop_Count < DE(P.Level).Shop_Count THEN 'if more shops available and not the exit room
IF X%% <> VAL("&H" + LEFT$(HEX$(DE(P.Level).ExitRoom), 1)) AND Y%% <> DE(P.Level).ExitRoom AND 15 THEN
'IF INT(RND * 255) > 230 THEN shops%% = INT(RND * 8) + 1
'Murals%% = INT(RND * 5) + 1 'shops auto get a mural
END IF
END IF
temp%% = VAL("&H" + HEX$(X%%) + HEX$(Y%%))
IF temp%% = DE(P.Level).ExitRoom THEN
FlagForExit%% = TRUE
Murals%% = INT(RND * 5) + 1 'exits auto get a mural
END IF
A$ = LEFT$("0000", 4 - LEN(_BIN$(colors%% AND 15))) + _BIN$(colors%% AND 15) + LEFT$("000", 3 - LEN(_BIN$(floor%% AND 7))) + _BIN$(floor%% AND 7)
IF windows%% THEN 'windows and columns are mutually exclusive, windows take precidence.
A$ = A$ + "10"
ELSEIF columns%% THEN
A$ = A$ + "01"
ELSE
A$ = A$ + "00"
END IF
A$ = A$ + LEFT$("000", 3 - LEN(_BIN$(Murals%% AND 7))) + _BIN$(Murals%% AND 7)
IF FlagForExit%% THEN A$ = A$ + "1111" ELSE A$ = A$ + LEFT$("0000", 4 - LEN(_BIN$(shops%% AND 15))) + _BIN$(shops%% AND 15): FlagForExit%% = FALSE
SUB Draw_Player
STATIC Frame%%, Count%%
IF P.Action = Standing THEN
ELSE 'if player is not standing then animate
Count%% = Count%% + 1
IF Count%% = 8 THEN Frame%% = NOT Frame%%: Count%% = 0
END IF
IF P.Action = Climbing THEN
_PUTIMAGE (64 + P.X, 16 + P.Y)-STEP(31, 63), Layer(15), Layer(1), (3 + (19 * ABS(Frame%%)), 37)-STEP(15, 31)
ELSEIF G.On_Ladder THEN 'player is not climbing then use main sprite array
IF P.Direction = UP OR P.Direction = DOWN THEN 'us climbing pose for up or down
_PUTIMAGE (64 + P.X, 16 + P.Y)-STEP(31, 63), Layer(15), Layer(1), (3 + (19 * ABS(Frame%%)), 37)-STEP(15, 31)
ELSE
_PUTIMAGE (64 + P.X, 16 + P.Y)-STEP(31, 63), Layer(15), Layer(1), (3 + (38 * P.Direction) + (19 * ABS(Frame%%)), 4)-STEP(15, 31)
END IF
ELSE
_PUTIMAGE (64 + P.X, 16 + P.Y)-STEP(31, 63), Layer(15), Layer(1), (3 + (38 * P.Direction) + (19 * ABS(Frame%%)), 4)-STEP(15, 31)
END IF
END SUB
SUB Fall_Death
'player fell off of ledge
P.Health = 0
DO
frame%% = frame%% + 1
IF frame%% = 1 THEN
P.Direction = P.Direction + 1
IF P.Direction = 8 THEN P.Direction = 0
P.Y = P.Y + 2
IF P.Y >= 484 THEN ExitFlag%% = TRUE
frame%% = 0
END IF
Draw_Map
Draw_Player
_PUTIMAGE , Layer(1), Layer(0)
ClearLayer Layer(1)
_LIMIT 60
LOOP UNTIL ExitFlag%%
Passage 0
G.FallDeath = FALSE
END SUB
SUB Move_Player
SELECT CASE P.Direction
CASE UP
P.Y = P.Y - 2 'movement
'Basic Wall collision
'check collision based on center point of player sprite, if true move P.Y back
IF Player_Collision(P.X, P.Y) THEN P.Y = P.Y + 2
CASE DOWN
P.Y = P.Y + 2 'movement
'Basic Wall collision
'check collision based on center point of player sprite, if true move P.Y back
IF Player_Collision(P.X, P.Y) THEN P.Y = P.Y - 2
'Item collision (only chest right now)
'Monster collision
CASE LEFT
P.X = P.X - 2 'movement
'Basic Wall collision
'check collision based on center point of player sprite, if true move P.Y back
IF Player_Collision(P.X, P.Y) THEN P.X = P.X + 2
CASE RIGHT
P.X = P.X + 2 'movement
'Basic Wall collision
'check collision based on center point of player sprite, if true move P.Y back
IF Player_Collision(P.X, P.Y) THEN P.X = P.X - 2
CASE UP_LEFT
'check each movement seperatly so player can 'slide' along walls
P.Y = P.Y - 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.Y = P.Y + 2
P.X = P.X - 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.X = P.X + 2
CASE UP_RIGHT
'check each movement seperatly so player can 'slide' along walls
P.Y = P.Y - 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.Y = P.Y + 2
P.X = P.X + 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.X = P.X - 2
CASE DOWN_LEFT
'check each movement seperatly so player can 'slide' along walls
P.Y = P.Y + 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.Y = P.Y - 2
P.X = P.X - 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.X = P.X + 2
CASE DOWN_RIGHT
'check each movement seperatly so player can 'slide' along walls
P.Y = P.Y + 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.Y = P.Y - 2
P.X = P.X + 2 'movement
IF Player_Collision(P.X, P.Y) THEN P.X = P.X - 2
END SELECT
IF NOT G.Scroll_Lock THEN 'only run if scrolling allowed
'scroll map if player reaches X max
IF G.Scroll_Direction = Horizontal THEN 'only scroll this way if flagged to do so
IF P.X > 354 THEN P.X = 354: G.Map.X = G.Map.X + 1
IF G.Map.X > Map(P.Level).MaxScroll THEN G.Map.X = Map(P.Level).MaxScroll 'stop scroll at edge
END IF
'scroll map if player reaches X min
IF G.Scroll_Direction = Horizontal THEN 'only scroll this way if flagged to do so
IF P.X < 118 THEN P.X = 118: G.Map.X = G.Map.X - 1
IF G.Map.X = -1 THEN G.Map.X = 0 'stop scroll at edge
END IF
IF G.Scroll_Direction = Vertical THEN 'only scroll this way if flagged to do so
IF P.Y > 300 THEN P.Y = 300: G.Map.Y = G.Map.Y + 1
IF G.Map.Y > Map(P.Level).MaxScroll THEN G.Map.Y = Map(P.Level).MaxScroll 'stop scroll at edge
END IF
IF G.Scroll_Direction = Vertical THEN 'only scroll this way if flagged to do so
IF P.Y < 100 THEN P.Y = 100: G.Map.Y = G.Map.Y - 1
IF G.Map.Y = -1 THEN G.Map.Y = 0 'stop scroll at edge
END IF
END IF
IF P.Level = 10 THEN
IF G.Map.X = 0 THEN G.Map.X = 2046
IF G.Map.X = 2048 THEN G.Map.X = 2
END IF
END SUB
SUB Passage (ID%%)
IF ID%% = 73 AND P.Burned = 7 THEN
'only allow player to take this passage if all bells are burned
Fade_Out Layer(0)
P.X = D(ID%%).P.X
P.Y = D(ID%%).P.Y
P.Level = D(ID%%).Level
G.Map.X = D(ID%%).M.X
G.Map.Y = D(ID%%).M.Y
G.Scroll_Direction = Map(P.Level).Scroll
G.Passage = FALSE
G.Scroll_Lock = D(ID%%).Scrolling
_DELAY .15
Draw_Map
Draw_Player
Fade_In Layer(1)
ELSEIF ID%% <> 73 THEN
Fade_Out Layer(0)
P.X = D(ID%%).P.X
P.Y = D(ID%%).P.Y
P.Level = D(ID%%).Level
G.Map.X = D(ID%%).M.X
G.Map.Y = D(ID%%).M.Y
G.Scroll_Direction = Map(P.Level).Scroll
G.Passage = FALSE
G.Scroll_Lock = D(ID%%).Scrolling
_DELAY .15
Draw_Map
Draw_Player
Fade_In Layer(1)
END IF
END SUB
SUB Pause_Game
Control_lock
Tmp& = _COPYIMAGE(Layer(0))
DO
KB~%% = Controls
_LIMIT 60
LOOP UNTIL _READBIT(KB~%%, 5)
_FREEIMAGE Tmp&
Control_lock
END SUB
SUB DT_Print (X%, Y%, Txt$)
L%% = LEN(Txt$)
FOR i%% = 1 TO L%%
C%% = ASC(MID$(Txt$, i%%, 1))
SELECT CASE C%%
CASE 65 TO 90 'A-Z
_PUTIMAGE (X% + 16 * i%%, Y%)-STEP(15, 15), Layer(13), Layer(1), (0 + 9 * (C%% - 65), 269)-STEP(7, 7)
CASE 48 TO 57 '0-9
_PUTIMAGE (X% + 16 * i%%, Y%)-STEP(15, 15), Layer(13), Layer(1), (0 + 9 * (C%% - 48), 278)-STEP(7, 7)
CASE 46 '.
_PUTIMAGE (X% + 16 * i%%, Y%)-STEP(15, 15), Layer(13), Layer(1), (0 + 9 * 13, 278)-STEP(7, 7)
END SELECT
NEXT i%%
END SUB
SUB Status_screen
Control_lock
DO
KB~%% = Controls
Control_lock
IF _READBIT(KB~%%, 2) THEN selection%% = selection%% - 1 'player pressed left arrow
IF _READBIT(KB~%%, 3) THEN selection%% = selection%% + 1 'player pressed right arrow
IF _READBIT(KB~%%, 6) THEN useitem%% = TRUE
IF _READBIT(KB~%%, 7) THEN dropitem%% = TRUE
IF selection%% = -1 THEN selection%% = 8
IF selection%% = 9 THEN selection%% = 0
FOR J%% = 1 TO P.Bells 'bells player has
_PUTIMAGE (480, 64 + 32 * J%%)-STEP(31, 31), Layer(13), Layer(1), (17 * 13, 303)-STEP(15, 15) 'bells
NEXT J%%
FOR J%% = 1 TO P.Burned 'bells player has bunred
_PUTIMAGE (480, 64 + 32 * J%%)-STEP(31, 31), Layer(13), Layer(1), (I(57).x, I(57).y)-STEP(15, 15) 'bells
NEXT J%%
FOR J%% = 0 TO 8 'items player has
_PUTIMAGE (112 + 48 * J%%, 400)-STEP(31, 31), Layer(13), Layer(1), (I(Pack(J%%)).x, I(Pack(J%%)).y)-STEP(15, 15)
NEXT J%%
IF useitem%% THEN Item_Use selection%%: useitem%% = FALSE
IF dropitem%% THEN Item_Drop selection%%: dropitem%% = FALSE
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 60
LOOP UNTIL _READBIT(KB~%%, 4)
Control_lock
END SUB
SUB Item_Use (ID%%)
'-----------equip-ables---------
SELECT CASE Pack(ID%%)
CASE 1 TO 4 'swords
P.Sword = Pack(ID%%)
CASE 5 TO 7 'helms
P.Helm = Pack(ID%%)
CASE 8 TO 10 'shields
P.Shield = Pack(ID%%)
CASE 11 TO 13 'armor
P.Armor = Pack(ID%%)
CASE 14, 15 'boots
P.Boots = Pack(ID%%)
CASE 16, 17 'enhancements
P.Enhance = Pack(ID%%)
CASE 18 TO 20 'gloves
P.Glove = Pack(ID%%)
CASE 36 'agate (orange) necklace
P.O_Necklace = TRUE 'adds a negligable amount of defence perminatly
END SELECT
'----------consume-ables----------
SELECT CASE Pack(ID%%)
CASE 25 'key
CASE 26 'torch
CASE 27 ' grail
P.Ludder = 255 'player gets full cash +5!(for that special item!)
CASE 28 'figure
G.Duration = 96
G.PauseEnemies = TRUE
CASE 31 TO 34 'potions
IF P.Health + I(Pack(ID%%)).Heal > P.MaxHealth THEN P.Health = P.MaxHealth ELSE P.Health = P.Health + I(Pack(ID%%)).Heal
CASE 35, 37, 38 'necklaces(minus agate(orange))
IF Pack(ID%%) = 35 THEN a = FALSE 'do something unknown
IF Pack(ID%%) = 37 THEN P.DefBonus = 8: G.Duration = 96
IF Pack(ID%%) = 38 THEN P.DefBonus = 127: G.Duration = 32 'invincable!
CASE 39 TO 42 'crystals
CASE 46 TO 49 'scrolls
IF Pack(ID%%) = 47 THEN Passage 29 'return to holy flame
IF Pack(ID%%) = 48 THEN Passage 0 'return to start point
CASE 59 'cursed shield
P.Shield = FALSE ' player looses shield!
P.Armor = FALSE 'player looses armor TOO!
CASE 60 'False grail
P.Ludder = 0 'player looses all cash
END SELECT
Pack(ID%%) = 0
Reduce_Pack ID%% 'remove empty item
END SUB
SUB Item_Drop (ID%%)
tmp& = _COPYIMAGE(Layer(1))
DO
_PUTIMAGE , tmp&, Layer(1)
KB~%% = Controls
Control_lock
FOR i%% = 0 TO 6 'anykey but 'b' exits routine
IF _READBIT(KB~%%, i%%) THEN ExitFlag%% = TRUE
NEXT i%%
IF _READBIT(KB~%%, 7) THEN 'press 'B' again to confirm
DT_Print 96, 368, RTRIM$(I(Pack(ID%%)).Name) + " DROPPED ! "
Pack(ID%%) = 0
ExitFlag%% = TRUE
Reduce_Pack ID%%
_PUTIMAGE , Layer(1), Layer(0)
_DELAY .75
END IF
IF NOT ExitFlag%% THEN DT_Print 96, 368, RTRIM$(I(Pack(ID%%)).Name) + " THROW AWAY?"
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 60
LOOP UNTIL ExitFlag%%
Layer(1) = _COPYIMAGE(tmp&)
_FREEIMAGE tmp&
END SUB
SUB Reduce_Pack (Start%%)
FOR i%% = Start%% TO 8
SWAP Pack(i%%), Pack(i%% + 1) 'move current `0'ed item to end
NEXT i%%
END SUB
SUB Run_Shop (ID%%)
END SUB
FUNCTION Controls~%%
IF _KEYDOWN(Control.Up_Key) THEN Result~%% = _SETBIT(Result~%%, 0) '1
IF _KEYDOWN(Control.Down_Key) THEN Result~%% = _SETBIT(Result~%%, 1) '2
IF _KEYDOWN(Control.Left_Key) THEN Result~%% = _SETBIT(Result~%%, 2) '4
IF _KEYDOWN(Control.Right_Key) THEN Result~%% = _SETBIT(Result~%%, 3) '8
IF _KEYDOWN(Control.Select_Button) THEN Result~%% = _SETBIT(Result~%%, 4) '16
IF _KEYDOWN(Control.Start_Button) THEN Result~%% = _SETBIT(Result~%%, 5) '32
IF _KEYDOWN(Control.A_Button) THEN Result~%% = _SETBIT(Result~%%, 6) '64
IF _KEYDOWN(Control.B_Button) THEN Result~%% = _SETBIT(Result~%%, 7) '128
Controls = Result~%%
END FUNCTION
FUNCTION Player_Collision%% (Xpos%, Ypos%)
Result%% = FALSE 'start with no collision
'passages
IF Bp1~%% = 255 AND Rp1~%% < 75 THEN Point1~& = Collide_White: G.Passage = TRUE: G.Where = Rp1~%% 'passage check
IF Bp2~%% = 255 AND Rp2~%% < 75 THEN Point2~& = Collide_White: G.Passage = TRUE: G.Where = Rp2~%% 'passage check
'dungeon passages
IF Bp1~%% = 255 AND Rp1~%% = 90 THEN Point1~& = Collide_White: G.Passage = TRUE: G.Door_Side = 0: G.Where = Dungeon(P.Level, P.DX, P.DY).N 'north door
IF Bp2~%% = 255 AND Rp2~%% = 90 THEN Point2~& = Collide_White: G.Passage = TRUE: G.Door_Side = 0: G.Where = Dungeon(P.Level, P.DX, P.DY).N '
IF Bp1~%% = 255 AND Rp1~%% = 91 THEN Point1~& = Collide_White: G.Passage = TRUE: G.Door_Side = 1: G.Where = Dungeon(P.Level, P.DX, P.DY).E 'east door
IF Bp2~%% = 255 AND Rp2~%% = 91 THEN Point2~& = Collide_White: G.Passage = TRUE: G.Door_Side = 1: G.Where = Dungeon(P.Level, P.DX, P.DY).E '
IF Bp1~%% = 255 AND Rp1~%% = 92 THEN Point1~& = Collide_White: G.Passage = TRUE: G.Door_Side = 2: G.Where = Dungeon(P.Level, P.DX, P.DY).W 'west door
IF Bp2~%% = 255 AND Rp2~%% = 92 THEN Point2~& = Collide_White: G.Passage = TRUE: G.Door_Side = 2: G.Where = Dungeon(P.Level, P.DX, P.DY).W '
IF Bp1~%% = 255 AND Rp1~%% = 93 THEN Point1~& = Collide_White: G.Passage = TRUE: G.Door_Side = 3: G.Where = Dungeon(P.Level, P.DX, P.DY).S 'south door
IF Bp2~%% = 255 AND Rp2~%% = 93 THEN Point2~& = Collide_White: G.Passage = TRUE: G.Door_Side = 3: G.Where = Dungeon(P.Level, P.DX, P.DY).S '
'ladder
IF Bp1~%% = 255 AND Rp1~%% = 255 AND Gp1~%% = 0 THEN P.Action = Climbing: G.On_Ladder = TRUE ELSE G.On_Ladder = FALSE
IF Bp2~%% = 255 AND Rp2~%% = 255 AND Gp2~%% = 0 THEN P.Action = Climbing
'fall off edge
IF Gp1~%% = 255 AND Bp1~%% = 0 AND Rp1~%% = 0 THEN Point1~& = Collide_White: G.FallDeath = TRUE 'cliff edge check
IF Gp2~%% = 255 AND Bp2~%% = 0 AND Rp2~%% = 0 THEN Point2~& = Collide_White: G.FallDeath = TRUE 'cliff edge check
'dungeons
IF Gp1~%% = 255 AND Bp1~%% < 11 AND Rp1~%% = 255 THEN Point1~& = Collide_White: G.Dungeon = Bp1~%% 'dungeon check
IF Gp2~%% = 255 AND Bp2~%% < 11 AND Rp2~%% = 255 THEN Point2~& = Collide_White: G.Dungeon = Bp2~%% 'dungeon check
'Dungeon Exit
IF Rp1~%% = 255 AND Gp1~%% = 1 AND Bp1~%% >= 75 THEN Point1~& = Collide_White: G.Exit_Dungeon = Bp1~%% 'dungeon check
IF Rp2~%% = 255 AND Gp2~%% = 1 AND Bp2~%% >= 75 THEN Point2~& = Collide_White: G.Exit_Dungeon = Bp2~%% 'dungeon check
'dungeon shop
IF Rp1~%% = 255 AND Gp1~%% = 0 AND Bp1~%% < 10 THEN Point1~& = Collide_White: G.Shop = Bp1~%% 'dungeon check
IF Rp2~%% = 255 AND Gp2~%% = 0 AND Bp2~%% < 10 THEN Point2~& = Collide_White: G.Shop = Bp2~%% 'dungeon check
'chests
'IF Point1~& = _RGB32(255, 0, 0) THEN Game.Chest = TRUE
'IF Point2~& = _RGB32(255, 0, 0) THEN Game.Chest = TRUE
' IF Point3~& = _RGB32(255, 0, 0) THEN Game.Chest = TRUE
' IF Point4~& = _RGB32(255, 0, 0) THEN Game.Chest = TRUE
'normal
IF Point1~& = Collide_White THEN Point1~& = FALSE ELSE Point1~& = TRUE
IF Point2~& = Collide_White THEN Point2~& = FALSE ELSE Point2~& = TRUE
' IF Point3~& = _RGB32(255) THEN Point3~& = TRUE ELSE Point3~& = FALSE
' IF Point4~& = _RGB32(255) THEN Point4~& = TRUE ELSE Point4~& = FALSE
IF Point1~& = FALSE OR Point2~& = FALSE THEN Result%% = TRUE
Player_Collision = Result%%
END FUNCTION
SUB ClearLayer (L&)
Old& = _DEST: _DEST L&: CLS: _DEST Old&
END SUB
SUB Control_lock
DO
LOOP WHILE Controls
END SUB
SUB DarkenImage (Image AS LONG, Value_From_0_To_1 AS SINGLE)
IF Value_From_0_To_1 <= 0 OR Value_From_0_To_1 >= 1 OR _PIXELSIZE(Image) <> 4 THEN EXIT SUB
DIM Buffer AS _MEM: Buffer = _MEMIMAGE(Image) 'Get a memory reference to our image
DIM Frac_Value AS LONG: Frac_Value = Value_From_0_To_1 * 65536 'Used to avoid slow floating point calculations
DIM O AS _OFFSET, O_Last AS _OFFSET
O = Buffer.OFFSET 'We start at this offset
O_Last = Buffer.OFFSET + _WIDTH(Image) * _HEIGHT(Image) * 4 'We stop when we get to this offset
'use on error free code ONLY!
$CHECKING:OFF
DO
_MEMPUT Buffer, O, _MEMGET(Buffer, O, _UNSIGNED _BYTE) * Frac_Value \ 65536 AS _UNSIGNED _BYTE
_MEMPUT Buffer, O + 1, _MEMGET(Buffer, O + 1, _UNSIGNED _BYTE) * Frac_Value \ 65536 AS _UNSIGNED _BYTE
_MEMPUT Buffer, O + 2, _MEMGET(Buffer, O + 2, _UNSIGNED _BYTE) * Frac_Value \ 65536 AS _UNSIGNED _BYTE
O = O + 4
LOOP UNTIL O = O_Last
'turn checking back on when done!
$CHECKING:ON
_MEMFREE Buffer
END SUB
SUB Fade_Out (L&)
FOR n! = 1 TO 0.00 STEP -0.05
i2& = _COPYIMAGE(L&)
DarkenImage i2&, n!
_PUTIMAGE (0, 0), i2&
_FREEIMAGE i2&
_DELAY .03
NEXT
END SUB
SUB Fade_In (L&)
FOR n! = 0.01 TO 1 STEP 0.05
i2& = _COPYIMAGE(L&)
DarkenImage i2&, n!
_PUTIMAGE (0, 0), i2&
_FREEIMAGE i2&
_DELAY .03
NEXT
END SUB
SUB MFI_Loader (FN$)
DIM Size(128) AS LONG, FOffset(128) AS LONG
OPEN FN$ FOR BINARY AS #1
GET #1, , c~%% 'retrieve number of files
FOR I~%% = 1 TO c~%%
GET #1, , FOffset(I~%%)
GET #1, , Size(I~%%)
FOffset&(I~%%) = FOffset&(I~%%) + 1
NEXT I~%%
_KEYCLEAR
Layer(13) = LoadGFX(FOffset(2), Size(2))
Layer(14) = LoadGFX(FOffset(4), Size(4))
Layer(15) = LoadGFX(FOffset(1), Size(1))
Layer(16) = LoadGFX(FOffset(3), Size(3))
LoadData FOffset(5), Size(5)
CLOSE #1
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
END SUB
SUB LoadData (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
F1 = FREEFILE
OPEN "temp.dat" FOR BINARY AS #F1
GET #F1, , Map()
GET #F1, , D()
GET #F1, , I()
GET #F1, , Dungeon()
GET #F1, , DE()
CLOSE #F1
END SUB
FUNCTION LoadGFX& (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadGFX& = _LOADIMAGE("temp.dat", 32)
END FUNCTION
FUNCTION LoadFFX& (Foff&, Size&, Fize%%)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadFFX& = _LOADFONT("temp.dat", Fize%%, "monospace")
END FUNCTION
FUNCTION LoadSFX& (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadSFX& = _SNDOPEN("temp.dat")
END FUNCTION
SUB maptest
FOR y%% = 0 TO 15
FOR x%% = 0 TO 15
IF Dungeon(1, x%%, y%%).Doorways > 0 THEN LINE (x%% * 7, y%% * 7)-STEP(4, 4), _RGB32(255, 255, 0), BF
IF _READBIT(Dungeon(1, x%%, y%%).Doorways, 0) THEN PSET (x%% * 7 + 2, y%% * 7), _RGB32(255, 0, 0)
IF _READBIT(Dungeon(1, x%%, y%%).Doorways, 1) THEN PSET (x%% * 7 + 4, y%% * 7 + 2), _RGB32(255, 0, 0)
IF _READBIT(Dungeon(1, x%%, y%%).Doorways, 2) THEN PSET (x%% * 7, y%% * 7 + 2), _RGB32(255, 0, 0)
IF _READBIT(Dungeon(1, x%%, y%%).Doorways, 3) THEN PSET (x%% * 7 + 2, y%% * 7 + 4), _RGB32(255, 0, 0)
NEXT x%%
NEXT y%%
_PUTIMAGE (0, 0)-STEP(299, 299), Layer(0), Layer(1), (0, 0)-STEP(149, 149)
CLS
_PUTIMAGE , Layer(1), Layer(0)
END
END SUB
