Author Topic: Maze Crawler  (Read 5540 times)

0 Members and 1 Guest are viewing this topic.

Offline Cobalt

  • QB64 Developer
  • Forum Resident
  • Posts: 878
  • At 60 I become highly radioactive!
    • View Profile
Maze Crawler
« on: December 05, 2018, 02:16:10 pm »
Here is an interesting take on the maze crawling games.
capable of generating near infinitely sized back traceable random mazes. limited only by memory size. Each room generated can lead to up to 3 new rooms and back to the previous room. this maze would be nearly impossible(at least very inconvenient) to map out as there is no 'round trip' movements. I mean that if you went up, left, down, right you would not end up in the original room. but if you reversed the movements, up,left,down,right then left,up,right,down you would find yourself back in the starting room.

I've never managed to pull this style of maze off before, but have always been fascinated by its possibility.
now this is just a proof of concept example and it is possible to start in a closed room, as I have not added any checking to prevent this yet. you can move around and it will display a 'mock' room but other than getting lost there is nothing else to do.

Code: QB64: [Select]
  1. 'on demand random retraceable maze
  2. TYPE Roomlook
  3.  up AS _BYTE
  4.  down AS _BYTE
  5.  left AS _BYTE
  6.  right AS _BYTE
  7.  
  8. TYPE room
  9.  North AS INTEGER 'what room lies in direction
  10.  South AS INTEGER
  11.  East AS INTEGER
  12.  West AS INTEGER
  13.  Walls AS Roomlook 'walls or passages
  14.  Created AS _BYTE 'as this room been visited?
  15.  
  16. DIM SHARED Maze(32000) AS room, a$, b$, c$(1), d$(5), e$(1)
  17. DIM SHARED lastmade%, wall$(3)
  18. CONST TRUE = -1, FALSE = NOT TRUE
  19. CONST UP = 1, DOWN = 2, LEFT = 3, RIGHT = 4
  20. a$ = "To the "
  21. b$ = " there is a "
  22. c$(0) = "wall": c$(1) = "passage"
  23. d$(UP) = "north": d$(DOWN) = "south": d$(LEFT) = "west": d$(RIGHT) = "east"
  24. e$(0) = "unknown": e$(1) = "known"
  25.  
  26. 'make maze ready to explore
  27. ClearMaze
  28. makerooms 'premake some wall sections
  29.  
  30. 'create the starting room
  31. 'pick which walls you can pass
  32. Maze(0).Walls.up = INT(RND * 2)
  33. Maze(0).Walls.down = INT(RND * 2)
  34. Maze(0).Walls.left = INT(RND * 2)
  35. Maze(0).Walls.right = INT(RND * 2)
  36. Maze(0).Created = TRUE
  37.  
  38. current% = 0 'room player is in
  39. lastmade% = 0 'last room created
  40.  
  41.  LOCATE 8, , 0 ' turn cursor off
  42.  DescribeRoom current%
  43.  
  44.  drawroom current%
  45.  LOCATE 8, 1, 1 ' turn cursor on
  46.  
  47.  DO
  48.   kbd& = _KEYHIT
  49.   _DELAY .05
  50.  LOOP UNTIL kbd&
  51.  
  52.  SELECT CASE kbd&
  53.   CASE 18432 'up
  54.    MessageHandler "You head north..."
  55.    IF Maze(current%).Walls.up THEN 'if you can go up
  56.     IF Maze(current%).North >= 0 THEN 'is north already referenced
  57.      MessageHandler "you have been here before"
  58.      current% = Maze(current%).North
  59.     ELSE 'never been north in this room
  60.      MessageHandler "you find somewhere new"
  61.      lastmade% = lastmade% + 1
  62.      nul% = CreateRoom(lastmade%, current%, UP)
  63.      current% = lastmade%
  64.     END IF
  65.    END IF
  66.   CASE 20480 'down
  67.    MessageHandler "You head south..."
  68.    IF Maze(current%).Walls.down THEN 'if you can go down
  69.     IF Maze(current%).South >= 0 THEN 'is south already referenced
  70.      MessageHandler "you have been here before"
  71.      current% = Maze(current%).South
  72.     ELSE 'never been south in this room
  73.      MessageHandler "you find somewhere new"
  74.      lastmade% = lastmade% + 1
  75.      nul% = CreateRoom(lastmade%, current%, DOWN)
  76.      current% = lastmade%
  77.     END IF
  78.    END IF
  79.   CASE 19200 'left
  80.    MessageHandler "You head west..."
  81.    IF Maze(current%).Walls.left THEN 'if you can go left
  82.     IF Maze(current%).West >= 0 THEN 'is west already referenced
  83.      MessageHandler "you have been here before"
  84.      current% = Maze(current%).West
  85.     ELSE 'never been west in this room
  86.      MessageHandler "you find somewhere new"
  87.      lastmade% = lastmade% + 1
  88.      nul% = CreateRoom(lastmade%, current%, LEFT)
  89.      current% = lastmade%
  90.     END IF
  91.    END IF
  92.   CASE 19712 'right
  93.    MessageHandler "You head east..."
  94.    IF Maze(current%).Walls.right THEN 'if you can go right
  95.     IF Maze(current%).East >= 0 THEN 'is east already referenced
  96.      MessageHandler "you have been here before"
  97.      current% = Maze(current%).East
  98.     ELSE 'never been north in this room
  99.      MessageHandler "you find somewhere new"
  100.      lastmade% = lastmade% + 1
  101.      nul% = CreateRoom(lastmade%, current%, RIGHT)
  102.      current% = lastmade%
  103.     END IF
  104.    END IF
  105.   CASE 27
  106.    exitflag%% = TRUE
  107.  kbd& = 0
  108. LOOP UNTIL exitflag%%
  109.  
  110.  
  111. FUNCTION CreateRoom (Going%, From%, Direction%%)
  112.  Maze(Going%).Walls.up = INT(RND * 2)
  113.  Maze(Going%).Walls.down = INT(RND * 2)
  114.  Maze(Going%).Walls.left = INT(RND * 2)
  115.  Maze(Going%).Walls.right = INT(RND * 2)
  116.  Maze(Going%).Created = TRUE
  117.  'which direction did player head
  118.  SELECT CASE Direction%%
  119.   CASE UP 'player went up
  120.    Maze(Going%).Walls.down = 1 'down has to be open, direction coming from
  121.    Maze(Going%).South = From% 'south goes back to previous room
  122.    Maze(From%).North = Going% 'the room id north of previous room
  123.   CASE DOWN
  124.    Maze(Going%).Walls.up = 1 'up has to be open, direction coming from
  125.    Maze(Going%).North = From% 'north goes back to previous room
  126.    Maze(From%).South = Going% 'the room id south of previous room
  127.   CASE LEFT
  128.    Maze(Going%).Walls.right = 1 'left has to be open, direction coming from
  129.    Maze(Going%).East = From% 'east goes back to previous room
  130.    Maze(From%).West = Going% 'the room id west of previous room
  131.   CASE RIGHT
  132.    Maze(Going%).Walls.left = 1 'right has to be open, direction coming from
  133.    Maze(Going%).West = From% 'west goes back to previous room
  134.    Maze(From%).East = Going% 'the room id east of previous room
  135.  
  136. SUB DescribeRoom (id%)
  137.  MessageHandler "You are currently in room" + STR$(id%)
  138.  MessageHandler a$ + d$(UP) + b$ + c$(Maze(id%).Walls.up)
  139.  MessageHandler a$ + d$(DOWN) + b$ + c$(Maze(id%).Walls.down)
  140.  MessageHandler a$ + d$(LEFT) + b$ + c$(Maze(id%).Walls.left)
  141.  MessageHandler a$ + d$(RIGHT) + b$ + c$(Maze(id%).Walls.right)
  142.  MessageHandler blank$
  143.  
  144. SUB ClearMaze
  145.  FOR i% = 0 TO 32000
  146.   Maze(i%).North = -1
  147.   Maze(i%).South = -1
  148.   Maze(i%).West = -1
  149.   Maze(i%).East = -1
  150.   Maze(i%).Created = FALSE
  151.  NEXT i%
  152.  
  153. SUB dumpmap
  154.  FOR i% = 0 TO lastmade%
  155.   PRINT #1, "room ID"; i%
  156.   PRINT #1, "north leads to "; Maze(i%).North
  157.   PRINT #1, "south leads to "; Maze(i%).South
  158.   PRINT #1, "west leads to "; Maze(i%).West
  159.   PRINT #1, "east leads to "; Maze(i%).East
  160.   PRINT #1, "up wall status "; Maze(i%).Walls.up
  161.   PRINT #1, "down wall status "; Maze(i%).Walls.down
  162.   PRINT #1, "left wall status "; Maze(i%).Walls.left
  163.   PRINT #1, "right wall status "; Maze(i%).Walls.right
  164.   PRINT #1,
  165.  NEXT i%
  166.  
  167. SUB drawroom (id%)
  168.  IF Maze(id%).Walls.up THEN 'has passage
  169.   LOCATE 10, 1: PRINT wall$(1)
  170.   LOCATE 10, 1: PRINT wall$(0)
  171.  FOR i%% = 11 TO 20
  172.   LOCATE i%%, 2: PRINT "³"
  173.   LOCATE i%%, 11: PRINT "³"
  174.  NEXT i%%
  175.  IF Maze(id%).Walls.left THEN 'has passage
  176.   LOCATE 14, 2: PRINT "Ù": LOCATE 15, 2: PRINT " ": LOCATE 16, 2: PRINT "¿"
  177.  IF Maze(id%).Walls.right THEN 'has passage
  178.   LOCATE 14, 11: PRINT "À": LOCATE 15, 11: PRINT " ": LOCATE 16, 11: PRINT "Ú"
  179.  IF Maze(id%).Walls.down THEN 'has passage
  180.   LOCATE 21, 1: PRINT wall$(3)
  181.   LOCATE 21, 1: PRINT wall$(2)
  182.  
  183. SUB makerooms
  184.  'ÚÄ¿³ÀÙ
  185.  wall$(0) = " ÚÄÄÄÄÄÄÄÄ¿ "
  186.  wall$(1) = " ÚÄÄÙ  ÀÄÄ¿ "
  187.  wall$(2) = " ÀÄÄÄÄÄÄÄÄÙ "
  188.  wall$(3) = " ÀÄÄ¿  ÚÄÄÙ "
  189.  
  190. SUB MessageHandler (txt$)
  191.  'define message area
  192.  VIEW PRINT 1 TO 9
  193.  'display message
  194.  LOCATE 9, 1: PRINT txt$
  195.  'restore screen area
  196.  _DELAY .33
  197.  
Granted after becoming radioactive I only have a half-life!

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Maze Crawler
« Reply #1 on: December 05, 2018, 02:51:56 pm »
Nice. I was wondering what a "crawler" was. It reminded me of games like Atari Haunted House.

If you also like traditional mazes, this is an interesting one created in QB 16 years ago by the former forum owner, Mac.

https://www.tapatalk.com/groups/qbasic/mazes-from-hell-version-2-t34310.html#p72064

It took me about 5 minutes to solve one and it has multiple mazes.

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Maze Crawler
« Reply #2 on: August 25, 2019, 07:47:06 pm »
This is a really cool maze game maker! I searched for "Maze Maker" and found this from last year. This can be turned into countless roll playing games.

Offline Cobalt

  • QB64 Developer
  • Forum Resident
  • Posts: 878
  • At 60 I become highly radioactive!
    • View Profile
Re: Maze Crawler
« Reply #3 on: August 26, 2019, 01:03:05 am »
This is a really cool maze game maker! I searched for "Maze Maker" and found this from last year. This can be turned into countless roll playing games.

Well, hey thanks! If you can use it, have at it. I had forgotten all about it.

Depending on how much memory (and 32bit or 64bit QB64 version) somebody could make a truly endless D&D dungeon campaign! change the INTEGER to INTEGER64 or DOUBLE and I don't believe anyone could explore it all, least not in one lifetime.
Even at LONG, only the most dedicated(and lifeless) nerd would try. But there would still be a lot of work to do, as of now this is nothing more than a shell. No real meat inside.
Granted after becoming radioactive I only have a half-life!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Maze Crawler
« Reply #4 on: August 26, 2019, 04:19:01 pm »
This is nice, does have potential and I am finding MessageHandler interesting too, thanks Cobalt :)

Offline johnno56

  • Forum Resident
  • Posts: 1270
  • Live long and prosper.
    • View Profile
Re: Maze Crawler
« Reply #5 on: August 26, 2019, 04:47:17 pm »
Um... I have a slight problem with the display of this game. I'm going to guess that it may be a font (or lack of font) issue. Can someone provide a solution?

Two images. The first is how the listing appears (to me) on the website. The second image is how it appears in the IDE.

 
qb64web.png


 
qb64ide.png
Logic is the beginning of wisdom.

Offline johnno56

  • Forum Resident
  • Posts: 1270
  • Live long and prosper.
    • View Profile
Re: Maze Crawler
« Reply #6 on: August 26, 2019, 04:49:16 pm »
Sorry... Clicked too often.  How can I delete this post?
qb64web.png
* qb64web.png (Filesize: 51.16 KB, Dimensions: 661x340, Views: 208)
« Last Edit: August 26, 2019, 04:53:12 pm by johnno56 »
Logic is the beginning of wisdom.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Maze Crawler
« Reply #7 on: August 26, 2019, 09:24:39 pm »
Not sure you can delete posts, except just click "Modify" and then erase everything on the post and type something like "Deleted By Poster".

Offline Cobalt

  • QB64 Developer
  • Forum Resident
  • Posts: 878
  • At 60 I become highly radioactive!
    • View Profile
Re: Maze Crawler
« Reply #8 on: August 31, 2019, 11:56:02 pm »
Um... I have a slight problem with the display of this game. I'm going to guess that it may be a font (or lack of font) issue. Can someone provide a solution?


that section is supposed to be ASCII extended characters. if you look in the IDE ASCII, 179,180,193,217 ect but for some reason when it was pasted here the extended character were changed.

Ill see if I can find the original source and take a snap shot.

found it, this image shows what those characters are supposed to be. I am surprised that they didn't restore when you pasted it into the IDE.
wallcharacters.jpg
* wallcharacters.jpg (Filesize: 7.96 KB, Dimensions: 250x127, Views: 213)
« Last Edit: September 01, 2019, 12:01:42 am by Cobalt »
Granted after becoming radioactive I only have a half-life!

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Maze Crawler
« Reply #9 on: September 01, 2019, 04:35:28 am »
I also get it wrong. This is because of the code page because our systems do not use the default English ASCII table, but another (from 128 to 255) due to the locale.

 
make rooms.GIF


So (and now excuse me if this is a totally stupid suggestion) theoretically using SHELL "Powershell culture" into the file after obtaining the LCID, additional tables could be implanted into the IDE that would translate this back  according to the LCID locale ID, or far better more simply, it would be enough for the IDE to automatically set the ASCII table to English basic ASCII. Either automatically or with a new command.
« Last Edit: September 01, 2019, 04:45:00 am by Petr »

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Maze Crawler
« Reply #10 on: September 01, 2019, 09:05:29 am »
I also tried to reset the text encoding in the IDE, unfortunately without success. I tried all the options in Options / Language. Unfortunately, without success. So my question is: With what font and with what coding (I think it should be the first one, 437) is this displayed correctly for someone?  If we know correct font,  can download the necessary font and to eliminate this problem in the future.

Offline Cobalt

  • QB64 Developer
  • Forum Resident
  • Posts: 878
  • At 60 I become highly radioactive!
    • View Profile
Re: Maze Crawler
« Reply #11 on: September 01, 2019, 01:05:27 pm »
I also tried to reset the text encoding in the IDE, unfortunately without success. I tried all the options in Options / Language. Unfortunately, without success. So my question is: With what font and with what coding (I think it should be the first one, 437) is this displayed correctly for someone?  If we know correct font,  can download the necessary font and to eliminate this problem in the future.

Afraid I'm not sure on that, as this is the standard BIOS font for computers sold in the US, although Petr looks like you have some of the correct characters, the other 'line' characters would not happen to be hidden in the ASCII display would they? or are they over written for phonetic characters?

I do have a QB program that lets you modify the bios font, I guess if no other way is found I'll make a font to use with it.
Granted after becoming radioactive I only have a half-life!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Maze Crawler
« Reply #12 on: September 02, 2019, 08:55:45 pm »
I also tried to reset the text encoding in the IDE, unfortunately without success. I tried all the options in Options / Language. Unfortunately, without success. So my question is: With what font and with what coding (I think it should be the first one, 437) is this displayed correctly for someone?  If we know correct font,  can download the necessary font and to eliminate this problem in the future.

Here's an option for you Petr -- fake fonts:

Code: QB64: [Select]
  1. DIM Font(255, x, y) AS _BYTE
  2.  
  3. SCREEN _NEWIMAGE(1024, 600, 32)
  4.  
  5. 'f$ = MapFont2Data$(16, Font(), "Font16")
  6. '_CLIPBOARD$ = f$
  7.  
  8. RESTORE Font16
  9. ReadFontData Font()
  10.  
  11. FakePrint 8, 16, "Hello World", Font()
  12. LOCATE 5, 2: PRINT "Hello World"
  13.  
  14.  
  15.  
  16.  
  17.  
  18. Font16:
  19. DATA 8,16
  20. DATA 789CED988176E3B80E43F5FF3FCDB7676A0297949CC869DA49DE44DD6D1D4BA20812043519E36BC47F3FEF31B6FD8C2BA05E1A3F5D8BF7C27FD1EA
  21. DATA 7AF9F436FEC401A18818F9F367F5D7FF4FC2FF78642E47759DDDE0823FE3C01F07F048FCC7CCD08B13B72E79FA8B95B1C1EE2FF8C773E2F78BE357C4
  22. DATA 4192A589D5AB77AAFF4DFE5F148B971D8FD6FFFF0B7E8CB802E902FE7F7D64FEFF6EC08AD0FB73F8CD0507EFF6BF222BE5ECB3553F341258925B9A3E
  23. DATA E3BFD8D26FE32F906FE27F30089BDE4AD333C799EAE082B6F67BF79F8EEA1CFF489B0F8C2DFC91EB1485C3BBBCD354D17BCEFDE7B823AC3D9DF13F38
  24. DATA 76769AE72DCE5F08A3E12F9F1EBFFFF4C9BF57FFD3E5868FD11325A67CBFFF3794B178BB7CF183A3EBFFE2F0E7DDFFD6F85F7E3CEDFEF32E807F6594
  25. DATA FBCFBDC834B188149B48061E6F6CF1BC87C47C665144BC5EBCBBE7E5EDD6056D495DC12D04669A1BD6E068F8393A92752D67F70B68B7644FBED9D3AB
  26. DATA DFFFDCF8277034FCB13C217BB03E45B6E0035664E2FDE1701E3158166324723771F6FB7074279FB6EF3F5A345918446B508D0376F038A8E1CF649303
  27. DATA 059CF23BBA270A5B30CA827B50C01F40322DBB7BFF31107B4047F6F0D3E72048E73F3C2DFCB1C40F8786C89347D94F1B28A57FF1FB9F05FE2CBBC6FF
  28. DATA 23AEEBFA27D5404825C2BC40848A62CDECCFCA7615D4F35AFD336A7BFC67CE91014C16FCE304FF344E2451B6C0821B762A23A830B91A9A386F7D04FF
  29. DATA 29A264FDE9FC5F1A73D0AEE8FF8566F1CF8E5275264F59D23794FAC71AC8B0D878FBF01BEFED49F0CF7E46A5FFB7B7041757ED3F8EA585DAFF217A6C
  30. DATA 0DA56BB103AC5C84660BA6643575594A7D3FA66BFC5D4A709E17BB1FA3A3644BCD8F3463C91FA3651D7AD6F113013A40CBF650504B4AAEE83F40EBD2
  31. DATA 409EE76C68A77EB56B53BB0FC0FFBA8E8FAD6C18B5B4C94E84303B8C05908AECCAFDC75885BFFA2CFC91E968F8CB9ED251F87971BD1A514C74E6AA88
  32. DATA 10FF41E23B43509BD29F77EE3FCABFA75461765266CBAD28BD04D18609A92CE465A7D7FF74A3E9E366FDEB0E1115F1D8E6FF4882A81C49A5197FA307
  33. DATA 4FC4E71243854026BAFE95D42C2270B6622A18DCD72EE067F45785C91CBDDEFD6731B6BD83A0D4ADAF8DEF97C7EDFB4F604979813B89F5A2CAF0569C
  34. DATA FB1AB74D7842FE5FC9BF7AC3124A2E0B2CB6BEF9E4F28F99544748D3C9FD679488CEF27F17BF7577AAFFABF8D3E128BB9526A4AD7514CABD7C6137C8
  35. DATA 76658FE52C4358B62D101874716FF59AE762ED4AFF4AB3C890C02BB5FCC4CD4E36A3A8F8DB4DC055702A3355CE071BEB1A2802C0A05CBCFFA467C1FD
  36. DATA E0A6536EAAB868FAE505F8D953FAFD67D56F7A1299BF39246BFCA4C5E86CC5B1B8FF944C02FFF1BBF2BFDD7FA465A3BDC02D25C9C6AB100560470989
  37. DATA 680E052BFF6AFF67FD470BA433357CFF99F4AF9F432101E8A1C73C7267F455243A4F6D6EECE34F520FE36F3596F87BFDBEE498A4F0C6D271928457C6
  38. DATA F7EB433256AA4BB3A3855C626265B25E480CAA34E22CC90D0A685A73A8947DF2D2D2D1AAAEA47ECB4F1D3606FE96B368B629E0843FCA0BCB103A52D1
  39. DATA BF61EF17FA6050FC1C6D859A9B1C553BDAC44F3D42E74060EBB4C33E7431C8F894B0D98A02146846E1870266C8EF0C6AC75CF2DDDA4F380A88610B63
  40. DATA F2319DC14B25129C37FE0C763A25C25A57AB40F7C2807E7ABDB08FEA753DAA4E30A352EF0C06D6ABFF17FC624263FFC159385EF0DB2931D69E9B1541
  41. DATA 60646654FC41F32A03B35074219E16221E024CA284F0A3844BA18073A27BE1AB2A49316E54CFCFA0B56D815B26A543E37C06E605D52CB72F753E3C05
  42. DATA 302E9B05FD33FF5A5455C075A73AB454389A85D5DEA230C93DE30725F265B10372F4DAE992A20316B37111BFBC2E82890C8B6A4EC678E5B1F28EF5A3
  43. DATA 2439E69F713E4CFBE3E35088D791AEDC8C429CDA68B4057AE69F2AF6D22214EB54A6A75EAD91A53EC94CE73F6A11C54F97E040C50F51AEAA67752C7D
  44. DATA 224052687C16F14AFF8A5975B07D4A4BF91254AA219057FC3869386FD05DBD77BF48E51475D028EC069B953F43EE64BC881A659524480D1C651BDEA6
  45. DATA 6EC37FFDD7CE925C8A2F453843089C280A6CFE4EF20C26AD844CEA7A525E15A243B722D968E716FC996E3B232B703ACF02FE41FC690961A2D0B2E093
  46. DATA 5BA32D77F560229384C0DAD8D026253E09C608907BD61207D28901793B7ED69CF329AA8B2B79AC4D1BBF45626806CA41F3A5C24AB83261036B0C550B
  47. DATA 725E592E04F303A39CB00CA204D936ED0E4B70325F0E5240F2A370170B4AB58A67203EA222F1CBF3F4BDD6C505FC72C15C6AD054FAF6A5C37FA1B148
  48. DATA CEE9D216B409FA678CD188E1EA18E49744AB3496AF5510AC13FE5B6F45332BB0A56E1479B158D65AB1CC505906B44367A28EA47B704C159C66587516
  49. DATA 33A18E8E5FF266B542F196F88644283D8B329B471501647B90DE16C9DCC24FE9CD682398521C5361D89E17E70C725F96A5322BD5EC183E8C2DA68660
  50. DATA C8C818B057C4AC6231FE28EFD438D24DF6E7CC22F0DB74A6A6E629EBE3309306C0F402C9142D00C48AA4A25285D4F5CA7106D019B607989B01742846
  51. DATA C36F0656FC0C4C09E0289B7C9A2BD960D579C2C7E6DE821F72925E506C9240A5F604B0054774A9281B151C571558E5BFA4C1F2E37ACCD901E366458A
  52. DATA 0EA26A5BC31E3B904C1EEA1FD526DF6EB2C10ED7688B90D635E0C902F552D0EF367E93C74C2F65963B693B6C3DCAF9893FEB523E6BDD267E85D9BC31
  53. DATA 7D4D54F28E255870BCC4A87EECE1CFB5BFE9E79B0C970972DF59D29F8A244D1A51F8CF4488663250B29564ECF5EF02ABBE6C20832CD7AA2BCB2C50AE
  54. DATA 9441E129708CBF780BBF55E74468AD6344C8D8059BA55C96D1CBF813521E6210D6BFAA6C0ABE9240C48A2035303F52D8336232917A0E020C2F42C8ED
  55. DATA 7F9BD463D55810C53A26B4E1BCF23CB97474C60C137B0E22D5E0A5170D410669CA54D01F1DD5F2D524AB87A9E97DBEC990AA50C44745030912C4D1F0
  56. DATA 972080A7E2867CA0C753B69C011F3174E2E816196C454D9192073EC3B880BFC42861E9A8C260975AE3BF39EF7A3009009F6E8666C37B750477473DDB
  57. DATA 9538F1DAC55FB8381FDC9832F15FB0ED528F925D9FD0959092825A2F8A2852885FDD2DFCC2990F3C2201A71B895B1686D76DE31F72390A7E99323BA2
  58. DATA 4DBEDEE8A271736943B2BFF51F1AAAEB223CF9EE5801BA1C3CB1244162DDDAA850ADDAF1370B53742EF53F48EB14E90BE494844FD42E562C721622D6
  59. DATA 047A85E152928D808F2E69092CA456458D2DB426E1571FCB26B51F00E9487D90FBD6FF230A79663E20098EC518FC3B32C119C8B04D489B5A5EF981A1
  60. DATA 180BC3D3616E537BFA07B1251C9B75CC870C20934CBC88A2BD61143532025AB251C45ED4C4EEE65E091302DD0AC4CAEE4E6412266B51DCEEA80DBF83
  61. DATA 401A0391027184B5E26F8E2A558E471E9FEF9230720FA9C30C4A2D1349DEB476AD33CDE6AC47F181B858FF4A929830FC8189F79141790AFF4F289CCF
  62. DATA CA6210918F965FD4BF37A7B7F7F92F1096594748F87D72DD02FCC3EBC4116745DA24FCD8ADDF193987B4B2461FCD46B109C570A5FE4D5613A28F2A89
  63. DATA 28F1571DDBDE5DE915FFEE70FE03B4CCC96389556E9475D4F480426145A976FE408C45678B6F37E592BB90FF7409D23C137CC21F0D7F107F4CF8D92D
  64. DATA ECB8F153CC307F823FAA19EB5F0FF83EFE34C0A8039FF41FD1C9109C458B7FF200352D3F7A0D14552D6C892616CF314D6EEA1F243B8910DC63FF0F01
  65. DATA 978FA1A8C051E8E99111328B5621FF3C0D2531266A26052AA6E2B0F3A9982B162894213E2A834DE59167505A398AE092283D4836697E105C4B05AD28
  66. DATA 3D2ECDE338E32795A2F4ACE8071B7F89B3503813AAE105FEB40D8A366425CDE04BCE86858BB970490F2C8122CCE9A48ED4FA1F5A9239BBCFFF118E0E
  67. DATA 763B52C0CFC0B5CAAB45DAEAC8BA32E32F9135254528F960F702BFE499F2597CD8C2EF1346C72F5305BF7EBFE68819C1F9D29746F25A23B5B3689927
  68. DATA F1D4E792F243352B7BCD3A34656A0F692CCA6160EEECCB5D48A882747D3ED6FC774DB6DA6A4D685A9A254FE142E34C75D312885ACEBBFEAB99B2F43C
  69. DATA 6EE7F8692BCD8D86AE2B6523807424E1B82F19B77B9A118E02893D023D06DBD3151B495185525FD1FF43FEEC5EE6AF45490E2743C3D693B8052DDC33
  70. DATA 8091B29D9120FE615F007481BF9040F021DE98CD5C65C433754CC8C00A594F6435FF27F8117F50D8CDAD9C3EEC8DC544F443F50880D20202392CAECF
  71. DATA A10DA80704D2F91A596CF920D4199B25FE41F89521A00C938F4957057F8BC02DA7C8EBF96075A92849BBBBFC4755878092D92295F1C33744A03C1703
  72. DATA 342EA68C4CF948E980BED43494F3446B7A551376A5FE915579D3B1C1809F5F796C7BD784EEEAF67F6BA0FE5F697C278160FAFD3D05FF8F84814DE7E2
  73. DATA A6F2E627F1DF5EFEBDB0DCC47F352CDBF79F7DEFCEF1C7FAF533C799E9E8CFA541BAFF9FDE7F760FDBC1BF35D68BEF35976DFCD939B7EF3F9B87EDF0
  74. DATA 7F6B9C1ED9B425567F6E9B79A4FFEFBBFDD3DABF26D54EE2E777EF88FF39E382A85DC2FFAF8F1F8AD5F35BC7054A3FDCFF9E37807FDDFFEF9CBAD0C5
  75. DATA 47EE3F1B8B7F16FF7802FEC3C005FD7F12FE6F44E6EED6CBF82F7EFFB37BE6D3F0C7F2D37CFFB9DEFF92403F7FFFF9CE38C57FF3FE73C7CCD7AB2F68
  76. DATA 2F7EFF59E39F261EB1FC86F7BF1F30FAB9FFFCC4F8AD58C5F4F0B085BB0B5FA0FFDBFCE9C39D0DD3C4BBE26FF79F47F17FCDFEEAFDE709C3F837FF45
  77. DATA 70DA177FE3FB9FE78FD3FE7F63C3D9CC6BDF7F4EC79D0BCFB699B7EAFFAB839E61E47DF17F737CBEFFF999F136B1BA40E917EA7F4F1B6FF6FDCFF3C7
  78. DATA 5FF8FEE7B5C65BDE7F9E375EFDFB9F1F1E2FFFFDCF4F8F77BFFF7D7B7CEE3F9FF1199FF1199FF1199FF1199FF1F8F81F5088E9D8
  79. DATA XX
  80.  
  81.  
  82.  
  83. SUB FakePrint (x, y, text$, array() AS _UNSIGNED _BYTE) 'the text and the font array
  84.     BG = _BACKGROUNDCOLOR
  85.     fw = UBOUND(array, 2): fh = UBOUND(array, 3)
  86.     COLOR , 0
  87.     FOR i = 1 TO LEN(text$)
  88.         FOR w = 0 TO fw
  89.             FOR h = 0 TO fh
  90.                 IF array(ASC(text$, i), w, h) THEN PSET (x + w, y + h)
  91.             NEXT
  92.         NEXT
  93.         x = x + fw
  94.     NEXT
  95.     COLOR , BG
  96.  
  97.  
  98. SUB MapFont (font, array() AS _BYTE, label$)
  99.     d = _DEST: s = _SOURCE: c = _CONTROLCHR
  100.     fw = _FONTWIDTH(font): fh = _FONTHEIGHT(font)
  101.     tempimage = _NEWIMAGE(fw, fh, 256)
  102.     _DEST tempimage: _SOURCE tempimage
  103.     _FONT font: _CONTROLCHR OFF
  104.  
  105.     REDIM array(0 TO 255, 0 TO fw - 1, 0 TO fh - 1) AS _BYTE
  106.     FOR i = 0 TO 255
  107.         CLS
  108.         PRINT CHR$(i);
  109.         FOR w = 0 TO fw - 1
  110.             FOR h = 0 TO fh - 1
  111.                 IF POINT(w, h) THEN array(i, w, h) = -1
  112.             NEXT
  113.         NEXT
  114.     NEXT
  115.     _DEST d: _SOURCE d: IF c = 0 THEN _CONTROLCHR ON
  116.  
  117.  
  118.  
  119. FUNCTION MapFont2Data$ (font, array() AS _BYTE, label$)
  120.     d = _DEST: s = _SOURCE
  121.     c = _CONTROLCHR
  122.     fw = _FONTWIDTH(font)
  123.     fh = _FONTHEIGHT(font)
  124.     tempimage = _NEWIMAGE(fw, fh, 256)
  125.     _DEST tempimage: _SOURCE tempimage
  126.     _FONT font
  127.  
  128.     REDIM array(0 TO 255, 0 TO fw - 1, 0 TO fh - 1) AS _BYTE
  129.     FOR i = 0 TO 255
  130.         CLS
  131.         PRINT CHR$(i);
  132.         FOR w = 0 TO fw - 1
  133.             FOR h = 0 TO fh - 1
  134.                 IF POINT(w, h) THEN array(i, w, h) = -1
  135.             NEXT
  136.         NEXT
  137.     NEXT
  138.  
  139.     DIM m AS _MEM: m = _MEM(array())
  140.     DIM temp AS STRING, temp1 AS STRING
  141.     s = ConvertOffset(m.SIZE)
  142.     temp1 = SPACE$(s)
  143.     _MEMGET m, m.OFFSET, temp1
  144.     temp = _DEFLATE$(temp1)
  145.     IF label$ = "" THEN label$ = "generic_label_placeholder:"
  146.     IF RIGHT$(label$, 1) <> ":" THEN label$ = label$ + ":"
  147.  
  148.     MapFont2Data$ = label$ + CHR$(10)
  149.     MapFont2Data$ = MapFont2Data$ + "DATA " + STR$(fw) + "," + STR$(fh) 'write fontwidth and height
  150.     MapFont2Data$ = MapFont2Data$ + CHR$(10) + "DATA "
  151.  
  152.     FOR i = 1 TO LEN(temp)
  153.         h$ = HEX$(ASC(temp, i))
  154.         IF LEN(h$) = 1 THEN h$ = "0" + h$
  155.         MapFont2Data$ = MapFont2Data$ + h$
  156.         IF i MOD 60 = 59 AND i < LEN(temp) THEN
  157.             MapFont2Data$ = MapFont2Data$ + CHR$(10) + "DATA "
  158.         END IF
  159.     NEXT
  160.     MapFont2Data$ = MapFont2Data$ + CHR$(10) + "DATA XX" 'write end of data characters
  161.     _DEST d: _SOURCE d
  162.     IF c = 0 THEN _CONTROLCHR ON
  163.  
  164. SUB ReadFontData (array() AS _BYTE)
  165.     DIM temp AS STRING, temp1 AS STRING
  166.     DIM fw AS INTEGER, fh AS INTEGER
  167.     READ fw, fh
  168.     DO
  169.         READ hx$
  170.         IF hx$ <> "XX" THEN
  171.             FOR i = 1 TO LEN(hx$) STEP 2
  172.                 h = VAL("&H" + MID$(hx$, i, 2))
  173.                 temp = temp + CHR$(h)
  174.                 o = o + 1
  175.             NEXT
  176.         ELSE
  177.             EXIT DO
  178.         END IF
  179.     LOOP
  180.     temp1 = _INFLATE$(temp)
  181.     REDIM array(0 TO 255, 0 TO fw, 0 TO fh) AS _BYTE
  182.     DIM m AS _MEM: m = _MEM(array())
  183.     _MEMPUT m, m.OFFSET, temp1
  184.     _MEMFREE m
  185.  
  186.  
  187.  
  188. FUNCTION ConvertOffset&& (value AS _OFFSET)
  189.     DIM m AS _MEM 'Define a memblock
  190.     m = _MEM(value) 'Point it to use value
  191.     $IF 64BIT THEN
  192.         ' On 64 bit OSes, an OFFSET is 8 bytes in size. We can put it directly into an Integer64.
  193.         _MEMGET m, m.OFFSET, ConvertOffset&& ' Get the contents of the memblock and put the values there directly into ConvertOffset&&.
  194.     $ELSE
  195.         'However, on 32 bit OSes, an OFFSET is only 4 bytes. We need to put it into a LONG variable first.
  196.         _MEMGET m, m.OFFSET, temp& ' Like this:
  197.         ConvertOffset&& = temp& ' And then assign that long value to ConvertOffset&&.
  198.     $END IF
  199.     _MEMFREE m ' Free the memblock.
  200.  

The above takes a font, compresses it, and then converts it into a set of DATA statements which we can put into our programs.
 Then, we can read those values back into an array and use them to manually plot the character to the screen.  Going this route, we carry our own fonts inside our BAS code/program, and never have to worry about what code page the user has set as their default on their system.  ;)

It's basically the same process which I use with my custom text routines here: (http://qb64.freeforums.net/thread/37/custom-routines-supports-textures-shading), with the only real difference being that I've used the new routines in the development build to compress the font array and turn it into an easy to insert set of DATA statements. 
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!