A "quine" is a program that when you run it, generates a listing of itself, such that if you took its output and copied into QB64, it would produce the same thing, itself.

Well, I tried writing one, yeah I could get the program to list itself, but generating the data to allow that program to display itself, and have it look exactly the same is the problem.  Because you have to act one step back, meaning if you have a string, you have to enclose it in quotation marks, which means you have to show the quote mark, Chr$(34). It's still a pain.

So I decided to see other ways this could be done. And one said to write a program to list itself as contents from an array. That made it trivial.

What I did was write the program to list itself. But now it needs the data. So to get that, I wrote another program. This one reads a file and converts it into DATA statements containing the byte values as data statements. I copied them, added an extra 0 at the end as an end-of-file sentinel, and sure enough, it works perfectly.

First, here is the program, which I call dataconvert.bas, that translates a file into data statements:

$Console:Only

'$Include:'Common_Dialog_Prefix.bi'

ReDim As _Unsigned _Byte Prg(1), L

Dim As Long I, J, K, Size





' Invoke Open Read File dialog

Filter$ = "Basic Programs (*.bas,bi.bm)|*.bas,*.bi,*.bm|All files (*.*)|*.*"

Flags& = OFN_FILEMUSTEXIST + OFN_NOCHANGEDIR + OFN_READONLY '    add flag constants here

F$ = GetOpenFileName$("Select name of Basic/QB64/qb64pe source code file", ".\", Filter$, 1, Flags&, Hwnd&)



If F$ = "" Then

    Print "Operation cancelled."

    End

End If



Open F$ For Binary Access Read As #1

I = LOF(1)

ReDim Prg(1 To I)

Get #1, , Prg()

Close #1



For J = 1 To I

    If L = 0 Then Print "Data ";

    Print LTrim$(Str$(Prg(J)));

    If J < I Then

        L = L + 1

        If L = 20 Then

            Print

            L = 0

        Else

            Print ",";

        End If

    Else

        Print

    End If

Next



End



'$Include:'Common_Dialog_Suffix.bi'

$Console:Only

Option _Explicit

Dim As _Unsigned _Byte Prg(1 To 100000), L

Dim As Long I, J, K



Do

    I = I + 1

    Read Prg(I)

    If Prg(I) = 0 Then Exit Do

Loop





For J = 1 To I

    Print Chr$(Prg(J));

Next



For J = 1 To I

    If L = 0 Then Print "Data ";

    Print LTrim$(Str$(Prg(J)));

    If J < I Then

        L = L + 1

        If L = 20 Then

            Print

            L = 0

        Else

            Print ",";

        End If

    Else

        Print

    End If

Next



End

Attached Files

  Quine2.zip (Size: 4.33 KB / Downloads: 25)

I happen to be writing a new section for the tutorial that highlights the use of the IDE and as such I am paying close attention to the IDE output screens.

I noticed something odd. Type the following line of code into the IDE and then press ENTER:

FOR x% = 1 TO 10

The IDE is reporting the line of code as an error as it should "FOR without NEXT" in the status window. However the second line in the Status window is a bit strange:

"Caused by (or after): SUB VWATCH ( )"

Is the second line reporting correctly?

inspired by steves addstrings, i modified join$ to speed it up.
join$(array$(), delimiter$) was for uniting an array into a single string with delimiters like commas, colons or nothing between the items in array.

I wanted to create a list of the QB/QB64 box-drawing characters that are emulated in the bytes above 127. But, what you see on screen may not be what you get from Windows.

I wrote a program to show all the different combinations of boxes one can create with the QB character set from Windows code page 437. So look at the following program, which modifies itself. Try loading and running this from the same directory that it is saved to.


  box_drawing.bas (Size: 1.77 KB / Downloads: 52)

Run this program from the QB64/QB64PE IDE, and notice the line drawing characters shown on screen? Using standard cmd copy/paste methods, hi light the text, then press enter to copy them. Try pasting them onto your screen, you get garbage. I suspected that intra-program copy/paste would work, but not between programs. So I added an INPUT statement and a print of what was typed.

But now, try reloading the program from disk, and the characters it posted to itself are what you would expect.

This confirmed what I suspected. When copy/paste in the same program, they can use any format for text. Transferring text from one program to another, I suspect Windows probably expects UTF-8 (or UTF-16) and if not there, it produces junk.

I found this quite amusing.

For word Processing we need a mouse that can handle double and triple clicks, along with drag, right click, the mouse wheel, and we'll throw in middle clicks because I'm fresh out of kitchen sinks...

Type mousevar

    mx As Integer ' Row.

    my As Integer ' Column.

    wh As Integer ' Wheel.

    lb_status As Integer ' Left Button Status.

    rb_status As Integer ' Right Button Status.

    mb_status As Integer ' Middle Button Status.

    click As Integer ' Number of timed left button clicks.

    CursorStyle As Integer ' 0 Default, 1 Link style. (Hand).

    mousekey As String ' Auto Keyboard Input.

End Type

Dim m As mousevar



i = 3: j = 1: a$ = "None" ' Seed.

Do

    _Limit 60

    ' Demo portion...

    If j > 80 Then i = i + 1: j = 1: If i > 24 Then End

    Select Case m.click

        Case 1: a$ = "Single": If m.lb_status = 2 Then a$ = "Drag"

        Case 2: a$ = "Double"

        Case 3: a$ = "Triple"

    End Select

    Select Case m.wh

        Case 0: b$ = "--"

        Case 1: b$ = "Dn"

        Case -1: b$ = "Up"

    End Select

    Locate 1, 3: Print "Row:"; m.my;: Locate 1, 11: Print "Col:"; m.mx;

    Locate 1, 23: Print "Lt:"; m.lb_status; "  Rt:"; m.rb_status; "  Md:"; m.mb_status; "  Whl: "; b$; "  Last Left Click: "; a$; "  ";



    mouse m

Loop



Sub mouse (m As mousevar)

    ' Local vars: i%, j%, k%, button_active, button_status

    Static As Integer oldmx, oldmy, button_active, last_active, button_status

    Static As Long mtimer

    If m.wh Then m.wh = 0

    While _MouseInput

        m.wh = m.wh + _MouseWheel

    Wend

    m.mx = _MouseX

    m.my = _MouseY

    i% = _MouseButton(1)

    j% = _MouseButton(2)

    k% = _MouseButton(3)

    If i% And button_active = 0 Then

        button_active = 1 ' Left button pressed.

    ElseIf j% And button_active = 0 Then

        button_active = 2 ' Right button pressed.

    ElseIf k% And button_active = 0 Then

        button_active = 3 ' Middle button pressed.

    ElseIf button_active And i% + j% + k% = 0 Then

        button_active = 0

    End If

    Select Case button_active

        Case 0

            Select Case button_status

                Case -2

                    button_status = 0 ' The clicked event and the release triggered any event structured to occur on release.

                Case -1

                    button_status = -2 ' The clicked event triggered any event structured to occur when the button is released.

                Case 0

                    ' Button has not been pressed yet.

                Case 1

                    button_status = -1 ' Rare but button was released before the next required cycle, so cycle is continued here.

                Case 2

                    button_status = -2 ' The drag event is over because the button was released.

            End Select

        Case Else

            Select Case button_status ' Note drag is determined in the text highlighting routine.

                Case -1

                    ' An event occurred and the button is still down.

                    If button_active = 1 Then ' Only left button for drag events.

                        If oldmx <> m.mx Or oldmy <> m.my Then

                            button_status = 2 ' Drag.

                        End If

                    End If

                Case 0

                    button_status = 1 ' Button just pressed.

                    If m.click = 0 And button_active = 1 Then

                        mtimer = Timer + .75

                        If mtimer > 86400 Then mtimer = mtimer - 86400 ' Midnight correction.

                    End If

                    m.click = Abs(m.click) + 1

                Case 1

                    button_status = -1 ' The button is down and triggered any event structured to occur on initial press.  The status will remain -1 as long as the button is depressed.

            End Select

    End Select

    m.lb_status = 0: m.rb_status = 0: m.mb_status = 0

    Select Case button_active

        Case 0

            Select Case last_active

                Case 1: m.lb_status = button_status

                Case 2: m.rb_status = button_status

                Case 3: m.mb_status = button_status

            End Select

        Case 1 ' Left

            m.lb_status = button_status

            If Abs(m.click) And button_status < 1 Then m.click = -Abs(m.click) Else m.click = Abs(m.click)

        Case 2 ' Right

            m.rb_status = button_status

        Case 3 ' Middle

            m.mb_status = button_status

    End Select

    If Timer > mtimer Then m.click = 0

    oldmx = m.mx: oldmy = m.my: last_active = button_active

End Sub

I LOVE qb64pe, and would hate to live without it. I use it to streamline my computer activities, much as I did with batch files in the olden days. I've even used it to run industrial equipment (once did that with DOS too). But there are always little things, that take me forever to get around to fixing, and this was one of those.

The start.command files on my Mac never worked properly. After years of ignoring it I finally decided to dig in and fix it. Turns out to be simple. If the program filename has spaces in it, the start.command malfunctions. It's the second line in the file:

cd "$(dirname "$0")"
./Open Web Image &
osascript -e 'tell application "Terminal" to close (every window whose name contains "Open Web Image_start.command")' &
osascript -e 'if (count the windows of application "Terminal") is 0 then tell application "Terminal" to quit' &
exit  

Because the filename has spaces in it, it needs to be in quotes or have the spaces escaped out with backslashes:
./"Open Web Image" &   OR
./Open\ Web\ Image &

So I went into the support folder, opened the qb64pe.bas program, searched for "start.command", and found the issue on line 13043.
Here is the block of code involved:

IF INSTR(_OS$, "[MACOSX]") THEN
        ff = FREEFILE
        IF path.exe$ = "./" OR path.exe$ = "../../" OR path.exe$ = "..\..\" THEN path.exe$ = ""
        OPEN path.exe$ + file$ + extension$ + "_start.command" FOR OUTPUT AS #ff
        PRINT #ff, "cd " + CHR$(34) + "$(dirname " + CHR$(34) + "$0" + CHR$(34) + ")" + CHR$(34);
        PRINT #ff, CHR$(10);
        PRINT #ff, "./" + file$ + extension$ + " &";
        PRINT #ff, CHR$(10);
        PRINT #ff, "osascript -e 'tell application " + CHR$(34) + "Terminal" + CHR$(34) + " to close (every window whose name contains " + CHR$(34) + file$ + extension$ + "_start.command" + CHR$(34) + ")' &";
        PRINT #ff, CHR$(10);
        PRINT #ff, "osascript -e 'if (count the windows of application " + CHR$(34) + "Terminal" + CHR$(34) + ") is 0 then tell application " + CHR$(34) + "Terminal" + CHR$(34) + " to quit' &";
        PRINT #ff, CHR$(10);
        PRINT #ff, "exit";
        PRINT #ff, CHR$(10);
        CLOSE #ff
        SHELL _HIDE "chmod +x " + AddQuotes$(path.exe$ + file$ + extension$ + "_start.command")
    END IF

I changed the highlighted line to:
PRINT #ff, "./" +  CHR$(34) + file$ + extension$ + CHR$(34) +  " &";

After compiling and running the new qb64pe program, no more issues. I should have done this years ago. I hope this is useful to others as well. Maybe this could be incorporated in the next release, if it doesn't mess up Windows machines?
True, I could use underscores in filenames instead of spaces, but where's the fun in that?
Now if I can only find the time to change those copy and paste keystrokes...

So I literally have over 7000 lines of code and just recently changed the value of a variable from a whole number to a decimal value. I'm now getting some strange results but can't seem to find which routine is causing the problem. 

Before entering a Sort routine I had a variable QS, which could carry a value between 1 and 4 depending on which of 4 arrays I  was directing to the QuickSort. I found that the array which was identified at #2, needed to be broken down to two different sorts so rather than redo all the QS numbers for the 4 arrays I simply changed #2 to 2.1 and 2.2. The code run sorts all the time and keeps track of how many sorts are being performed (mostly to see how I can improve things)

When I ran the code everything worked fine , QS = 2.1 and QS = 2.2 were sorting ok until sort # 42. From sort # 42 and onwards, QS would not recognize the decimal values but somehow QS = 2 returned. It appears as if the 2.1 and 2.2 values of QS dropped off and QS from sort #42 an onwards became = to 2

I'm having trouble finding where this change in value occurred. It's not showing up in a simple search where I may have inadvertently use 2 rather than 2.1 or 2.2 so it must be in something like a Select Case where the Cases will not recognize anything other than the whole number, or maybe an IF statement or a Loop statement or some kind of an Assignment statement which only deals with integers. I do have multiple nested IF's and Loops.

I realize the simple solution is to go back, do not change #2 to 2.1 and 2.2 but just create a 5th and I will do this but if I can figure out why, after 42 sorts the decimal value is dropped then either I won't do that again or I can get the program back on track with a simple change of something at sort #42.

You guys have any thoughts on what command/function/routine that will only recognize a variable as an integer?

       

When I was a kid, we had a book called "Beyond Competition."  It contained a handful of cooperative games, the one I remember most fondly is "Space Explorer."  To play, compile the code and make sure the following resource file is in the same folder:


  resource.mfi (Size: 918.14 KB / Downloads: 59)

$noprefix



const true = -1

const false = 0



type coordinate_dec

  x as double

  y as double

end type

type coordinate_int

  x as integer

  y as integer

end type

type coordinate_byte

  x as byte

  y as byte

end type



' ----- Settings -----



dim shared option_sound      as byte ' True is on, false is off

dim shared option_window_size as byte ' 1=640x360, [2=1280x720], 3=1920x1080

option_sound      = true

option_window_size = 2

load_settings



'do: loop until screenexists = true

title "Space Explorer"



' ----- Images and screen -----



const screenw = 640

const screenh = 360

dim shared full_screen as unsigned long

full_screen = newimage(screenw, screenh, 32)

screen full_screen



dim shared background_image    as unsigned long

dim shared grid_image          as unsigned long

dim shared sprite_image        as unsigned long

dim shared icon_image          as unsigned long

dim shared how_to_play_image(4) as unsigned long

dim shared landing_image(9)    as unsigned long

dim shared gameover_image      as unsigned long

dim shared reference_image      as unsigned long



dim shared store_screen as unsigned long ' Anytime screen state should be stored



dim shared scaled_screen(3) as unsigned long

scaled_screen(1) = newimage( 640,  360, 32)

scaled_screen(2) = newimage(1280,  720, 32)

scaled_screen(3) = newimage(1920, 1080, 32)

screen scaled_screen(option_window_size)



displayorder hardware



source full_screen ' Prevent handles from ever being null

dest  full_screen



dim shared camera_x as double

dim shared camera_y as double



' ----- Sprite constants -----



' Cards, numbers are found via animation frame



const spr_card_large      = 1

const spr_card_small      = 2

const spr_deck            = 3

const spr_cursor          = 4

const spr_cursor_trail    = 5

const spr_fuel            = 6



' Path components



const spr_path            = 11 ' 6 rotations

const spr_ship            = 21 ' 6 rotations



' Planets, take off and landing



const spr_planet          = 31

const spr_sun            = 41

const spr_asteroid        = 42 ' 4 variations

const spr_reticle        = 43



' Hex menu icons, inactive and highlighted versions



const spr_iconx_move      = 71 ' 6 rotations

const spr_icono_move      = 72 ' 6 rotations

const spr_iconx_turnsoftl = 73 ' 6 rotations

const spr_icono_turnsoftl = 74 ' 6 rotations

const spr_iconx_turnsoftr = 75 ' 6 rotations

const spr_icono_turnsoftr = 76 ' 6 rotations

const spr_iconx_turnhardl = 77 ' 6 rotations

const spr_icono_turnhardl = 78 ' 6 rotations

const spr_iconx_turnhardr = 79 ' 6 rotations

const spr_icono_turnhardr = 80 ' 6 rotations

const spr_iconx_depart    = 81 ' 6 rotations

const spr_icono_depart    = 82 ' 6 rotations

const spr_iconx_discard  = 83 ' 6 copies, but none are rotated

const spr_icono_discard  = 84 ' 6 copies, but none are rotated



const sprite_total        = 100

dim shared sprite_ref(sprite_total) as integer



' --- Sound effects ---



const sfx_menu_move    = 1 ' Move menu cursor

const sfx_menu_confirm = 2 ' Confirm menu selection



const sfx_card        = 3 ' One card flip

const sfx_shuffle      = 4 ' Deck shuffle



const sfx_rocket      = 5 ' Moving forward

const sfx_thruster    = 6 ' Turning

const sfx_landing      = 7 ' Landing on planet

const sfx_takeoff      = 8 ' Launching from planet



const sfx_total        = 8

dim shared sfx(sfx_total, 100) as unsigned long



' ----- Resource file -----



dim shared mfi_s(255) as long ' Size

dim shared mfi_o(255) as long ' Offset

dim shared mfi_count  as unsigned byte

dim shared mfi_index  as unsigned byte

mfi_loader "resource.mfi"



type sprite_structure

  pos      as coordinate_int ' position in sprite sheet

  size      as coordinate_int ' size of sprite in sheet

  size_draw as coordinate_int ' size of sprite when displayed - equal to size.xy if no stretch

  frames    as integer        ' sprite's frames of animation

  fpf      as byte          ' Frame counter ticks per animation frame (0 defaults to 1)

  hb_offset as coordinate_int ' display position relative to hitbox position

  hb_size  as coordinate_int ' size of hitbox, to be copied to entity_spec().size.xy after parse

  image    as unsigned long  ' Handle of sprite sheet

end type

dim shared sprite_count        as integer

dim shared sprite(1000) as sprite_structure



parse_sprites sprite_image

parse_sprites icon_image

set_sprite_ref



' ----- Fonts -----



const fonts = 3

' Glass Fonts - custom pixel font processing and drawing



type font_structure

  image as unsigned long

  pos  as coordinate_int

  h    as integer

  w    as integer

end type



' Alignment in font calls

const left_align  = 0

const right_align  = 1

const center_align = 2



dim shared g_font(fonts, 255) as font_structure ' Number of fonts comes from main program header



' Current font options in use

dim shared font_using as byte          ' Index of current font being used

dim shared font_align as byte          ' Alignment

dim shared font_dest  as unsigned long  ' Destination image surface

dim shared font_x    as integer        ' Rolling font position, set by each glass_fonts call

dim shared font_y    as integer



' Font references

const f_loxica    = 1 ' Height 16 inclusive

const f_gaia_blue = 2 ' Height 20 inclusive

const f_gaia_red  = 3



' ----- Sort and shuffle -----



type sort_structure

  s_index as integer ' Reference to array being sorted

  s_value as single  ' Value being used for sorting

end type



const card_limit = 24

dim shared sorting(card_limit)  as sort_structure ' Before sort

dim shared sorting_count        as integer

dim shared sorted(2, card_limit) as sort_structure ' After sort

dim shared sorted_count(2)      as integer



' ----- Directional data -----



' Grid is along two axes, x increases to the northeast, y increases to the south

' Valid moves can be four cardinals, as well as NW (-1, -1) and SE (+1, +1) diagonals



dim shared move_delta(6) as coordinate_byte

move_delta(1).x =  0: move_delta(1).y = -1

move_delta(2).x =  1: move_delta(2).y =  0

move_delta(3).x =  1: move_delta(3).y =  1

move_delta(4).x =  0: move_delta(4).y =  1

move_delta(5).x = -1: move_delta(5).y =  0

move_delta(6).x = -1: move_delta(6).y = -1



const up    = 1

const right = 2

const down  = 3

const left  = 4

dim shared arrow(4) as string * 2

arrow(up)    = chr$(0) + chr$(72)

arrow(right) = chr$(0) + chr$(77)

arrow(down)  = chr$(0) + chr$(80)

arrow(left)  = chr$(0) + chr$(75)



const boardw = 28

const boardh = 31 ' Actual size is 27x30, one wide border is added to simplify checking for valid moves



' ----- Game state data -----



dim shared valid_cell(boardw, boardh) as byte

dim shared dir_used(boardw, boardh, 6) ' Set to true when that direction leaving/entering a cell has been used



dim shared player_count  as byte

player_count = 4

dim shared turn          as byte ' Player currently taking turn

dim shared asteroid_seed as byte ' Determined at game start, used to select asteroid appearances



const state_moved  = 1 ' Last action was a forward move to an empty cell

const state_turned = 2 ' Last action was a turn or planet departure

const state_landed = 3 ' Last action was a forward move to a planet

dim shared ship_state  as byte

dim shared ship_pos    as coordinate_byte ' Ship position

dim shared travel      as byte ' Direction currently traveling

dim shared next_planet as byte ' Next planet to be visited

dim shared fuel_tanks  as byte ' Fuel remaining, starting value affected by player_count



dim shared actions_taken(4)  as byte    ' Non-discard actions taken by each player

dim shared distance_traveled as integer ' Total distance traveled in hexes



dim shared planet_name$(10)

dim shared planet_preset(10, 6) as coordinate_byte

dim shared planet_at(boardw, boardh) as byte ' Index of planet located here, false if none, true if unused preset

dim shared planet_pos(10) as coordinate_byte ' Position of each planet on board



for x = 0 to boardw

  for y = 0 to boardh

      planet_at(x, y) = false

      valid_cell(x, y) = true

      if x = 0 or x = boardw or y = 0 or y = boardh then valid_cell(x, y) = false



      for d = 1 to 6: dir_used(x, y, d) = false: next d

  next y



  ' Top edge

  if x <> 4 then valid_cell(x, 1) = false

  if x < 4 or x > 6 then valid_cell(x, 2) = false

  if x = 2 or x = 3 or x > 8 then valid_cell(x, 3) = false

  if x > 10 then valid_cell(x, 4)  = false

  if x > 12 then valid_cell(x, 5)  = false

  if x > 14 then valid_cell(x, 6)  = false

  if x > 16 then valid_cell(x, 7)  = false

  if x > 18 then valid_cell(x, 8)  = false

  if x > 20 then valid_cell(x, 9)  = false

  if x > 22 then valid_cell(x, 10) = false

  if x > 24 then valid_cell(x, 11) = false

  if x > 24 then valid_cell(x, 12) = false

  if x > 25 then valid_cell(x, 13) = false

  if x > 26 then valid_cell(x, 14) = false



  ' Bottom edge

  if x < 3  then valid_cell(x, 18) = false

  if x < 5  then valid_cell(x, 19) = false

  if x < 7  then valid_cell(x, 20) = false

  if x < 9  then valid_cell(x, 21) = false

  if x < 10 then valid_cell(x, 22) = false

  if x < 11 then valid_cell(x, 23) = false

  if x < 12 then valid_cell(x, 24) = false

  if x < 14 then valid_cell(x, 25) = false

  if x < 16 then valid_cell(x, 26) = false

  if x < 18 then valid_cell(x, 27) = false

  if x < 20 then valid_cell(x, 28) = false

  if x < 24 then valid_cell(x, 29) = false

  if x < 26 then valid_cell(x, 30) = false

next x



'                        board xx,yy    1      2      3      4      5      6

const mercury = 1: set_preset mercury,  14,14,  15,15,  15,16,  14,16,  13,15,  13,14,  "Mercury"

const venus  = 2: set_preset venus,    14,12,  17,15,  17,18,  14,18,  11,15,  11,12,  "Venus"

const mars    = 3: set_preset mars,    15,10,  20,16,  19,21,  13,20,  8,14,  9, 9,  "Mars"

const jupiter = 4: set_preset jupiter,  19,13,  21,20,  16,22,  9,17,  7,10,  12, 8,  "Jupiter"

const saturn  = 5: set_preset saturn,  17, 9,  23,18,  20,24,  11,21,  5,12,  8, 6,  "Saturn"

const uranus  = 6: set_preset uranus,  21,12,  24,22,  17,25,  7,18,  4, 8,  11, 5,  "Uranus"

const neptune = 7: set_preset neptune,  25,14,  26,21,  23,27,  4,17,  2,12,  5, 3,  "Neptune"

const pluto  = 8: set_preset pluto,    23,11,  27,19,  27,26,  20,28,  1, 9,  1, 4,  "Pluto"

const earth  = 9: set_preset earth,    16,13,  18,17,  16,19,  12,17,  10,13,  12,11,  "Earth"

valid_cell(14, 15) = false ' Sun



dim shared deck(card_limit) as byte ' Contents of the main deck

dim shared deck_size        as byte ' Size of the main deck

dim shared hand(4, 3)      as byte ' Contents of each player's hand

dim shared hand_size(4)    as byte ' Size of each player's hand



' ----- Hand display dimensions -----



const x_offset = 20 ' x pixel change when moving horizontally on board

const y_offset = 26 ' y pixel change when moving vertically on board



dim shared hand_ox(4, 2)    as integer ' Player hand display top-left corner, second index is card size toggle

dim shared hand_oy(4, 2)    as integer

dim shared hand_offset(2)  as integer ' Pixel spacing between cards in hand

for s = spr_card_large to spr_card_small: hand_offset(s) = int((size_x(sprite_ref(s)) + 1) * 0.7): next s



margin = 2

x1 = margin                                                              ' Left column large and small cards

y1 = margin                                                              ' Top row large and small cards



s = spr_card_large

x2 = screenw - 1 - size_x(sprite_ref(s)) - (hand_offset(s) * 2) - margin ' Right column large cards

y2 = screenh - 1 - size_y(sprite_ref(s)) - margin                        ' Bottom row large cards

hand_ox(1, s) = x1: hand_oy(1, s) = y1 ' Large cards

hand_ox(2, s) = x2: hand_oy(2, s) = y1

hand_ox(3, s) = x1: hand_oy(3, s) = y2

hand_ox(4, s) = x2: hand_oy(4, s) = y2



s = spr_card_small

x3 = screenw - 1 - size_x(sprite_ref(s)) - (hand_offset(s) * 2) - margin ' Right column small cards

y3 = screenh - 1 - size_y(sprite_ref(s)) - margin                        ' Bottom row small cards

hand_ox(1, s) = x1: hand_oy(1, s) = y1 ' Small cards

hand_ox(2, s) = x3: hand_oy(2, s) = y1

hand_ox(3, s) = x1: hand_oy(3, s) = y3

hand_ox(4, s) = x3: hand_oy(4, s) = y3



' Floating cursor



const trail_length = 3

dim shared cursor_pos(trail_length) as coordinate_int ' Display position of cursor (nonzero indices are trail)

dim shared cursor_goal as coordinate_int ' Destination of cursor

cursor_goal.x = 0

cursor_goal.y = 0



dim shared reticle_flash as byte

dim shared ship_frame    as byte











' Title screen



dim menu_text$(6)

menu_start  = 1

menu_how    = 2

menu_sound  = 3

menu_window = 4

menu_quit  = 5



cy = 1

do

  putimage(0, 0), background_image, full_screen, (inthalf(width(background_image) - screenw),_

  inthalf(height(background_image) - screenh))-step(screenw - 1, screenh - 1)



  menu_text$(menu_start)  = "Start game - < " + trim$(str$(player_count)) + " Player >"

  menu_text$(menu_how)    = "How to play"

  if option_sound = true then menu_text$(menu_sound) = "Sound: < ON >" else menu_text$(menu_sound) = "Sound: < OFF >"

  menu_text$(menu_window) = "Window size: < x" + trim$(str$(option_window_size)) + " >"

  menu_text$(menu_quit)  = "Quit"



  set_font f_gaia_blue, center_align, full_screen

  font_pos inthalf(screenw), 110

  glass_fonts_at "- SPACE EXPLORER -"

  glass_fonts_at ""

  for m = menu_start to menu_quit

      set_font f_gaia_blue, center_align, full_screen

      t$ = menu_text$(m)

      if cy = m then font_using = f_gaia_red else t$ = text_replace$(text_replace$(t$, "< ", ""), " >", "")

      glass_fonts_at t$

  next m



  do

      limit 60

      display_screen

      k$ = inkey$

  loop while k$ = ""



  if k$ = arrow(up)  then play_sound sfx_menu_move: cy = wrap(cy - 1, menu_start, menu_quit)

  if k$ = arrow(down) then play_sound sfx_menu_move: cy = wrap(cy + 1, menu_start, menu_quit)



  dx = 0

  if k$ = arrow(right) or k$ = chr$(13) or k$ = " " then dx = 1

  if k$ = arrow(left) then dx = -1



  select case cy

      case menu_start

        if k$ <> chr$(13) and k$ <> " " then play_sound sfx_menu_move: player_count = wrap(player_count + dx, 2, 4)

      case menu_sound

        option_sound = wrap(option_sound + dx, true, false)

        if dx <> 0 then play_sound sfx_menu_move

      case menu_window

        option_window_size = wrap(option_window_size + dx, 1, 3)

        if dx <> 0 then play_sound sfx_menu_move: screen scaled_screen(option_window_size): dest full_screen

  end select



  if k$ = chr$(27) then play_sound sfx_menu_move: cy = menu_quit



  if k$ <> chr$(13) and k$ <> " " then continue

  if cy = menu_quit then system



  play_sound sfx_menu_confirm



  if cy = menu_how then

      h_page = 1

      do

        putimage(0, 0), background_image, full_screen, (inthalf(width(background_image) - screenw),_

        inthalf(height(background_image) - screenh))-step(screenw - 1, screenh - 1)



        ' Instructional splash image

        putimage(0, 0), how_to_play_image(h_page), full_screen



        ' Text

        set_font f_loxica, left_align, full_screen

        select case h_page

            case 1

              glass_fonts "Your mission is to visit each planet in the solar system,", 70, 27

              glass_fonts "then return to Earth.", 70, 42



              glass_fonts "You must visit the planets in order moving outward from the Sun,", 202, 171

              glass_fonts "so Mercury first, Pluto last.", 202, 186



              glass_fonts "Be careful, you have a limited supply of fuel!", 55, 256

              glass_fonts "One unit of fuel is spent each time the deck runs out of cards.", 55, 271

              glass_fonts "If you run out of fuel and cards, you'll be stranded in space!", 55, 286



            case 2

              glass_fonts "Play any card to move forward that number of spaces.", 164, 8

              glass_fonts "Asteroids must be avoided, you can't move through them.", 164, 23

              glass_fonts "You also cannot move along a path you previously used.", 164, 38



              glass_fonts "You can make a shallow turn left or right by playing a 5 or 6.", 129, 180

              glass_fonts "Sharp turns can be made with a 3, 4, or 6.", 129, 195

              glass_fonts "Once you've made a turn, you must move forward before turning again.", 129, 210



            case 3

              glass_fonts "To land on a planet, you need to move exactly the right distance.", 45, 102

              glass_fonts "You cannot move through planets normally.", 45, 117



              glass_fonts "After landing, you must choose a launch direction.", 193, 194

              glass_fonts "Playing 1 will launch you to the north, 2 launches northeast,", 193, 209

              glass_fonts "and so on clockwise, so 6 launches northwest.", 193, 224



              glass_fonts "Turning and launch angles are displayed during the game for reference.", 213, 282



            case 4

              glass_fonts "Each turn, you can play any number of cards.", 63, 101

              glass_fonts "If you play nothing, then discard two cards to pass your turn.", 63, 116

              glass_fonts "To do this, choose the card you'll keep, then choose 'discard.'", 63, 131



              glass_fonts "Each player has a hand of three cards, and everyone can see all hands.", 121, 249

              glass_fonts "Work together and plan ahead to complete your mission!", 121, 264

        end select



        glass_fonts "Page " + trim$(str$(h_page)) + "/4", 10, screenh - 10 - g_font(font_using, 0).h



        do

            limit 60

            display_screen

            k$ = inkey$

        loop while k$ = ""



        if k$ = arrow(left) then

            if h_page > 1 then play_sound sfx_menu_move

            h_page = max(h_page - 1, 1)

        end if

        if k$ = arrow(right) or k$ = chr$(13) or k$ = " " then

            if h_page < 4 then play_sound sfx_menu_move

            if h_page => 4 and k$ <> arrow(right) then exit do

            h_page = min(h_page + 1, 4)

        end if

        if k$ = chr$(27) then play_sound sfx_menu_move: exit do

      loop

  end if



  if cy <> menu_start then continue



  ' Start game



  asteroid_seed = timer

  randomize timer



  select case player_count

      case 2: fuel_tanks = 7

      case 3: fuel_tanks = 8

      case 4: fuel_tanks = 10

  end select

  for n = 1 to 4: actions_taken(n) = 0: next n

  distance_traveled = 0

  for n = 1 to card_limit: sorting(n).s_index = ((n - 1) mod 6) + 1: next n

  sorting_count = card_limit

  shuffle_deck

  for p = 1 to player_count: fill_hand(p): next p

  turn = 1

  for x = 0 to boardw: for y = 0 to boardh: for d = 1 to 6

      dir_used(x, y, d) = false

  next d: next y: next x



  ' Planet positions



  for p = 1 to 9

      for r = 1 to 6

        planet_at( planet_preset(p, r).x, planet_preset(p, r).y) = true

        valid_cell(planet_preset(p, r).x, planet_preset(p, r).y) = false

      next r

      set_planet p, rand(6)

  next p



  ship_pos.x = planet_pos(earth).x

  ship_pos.y = planet_pos(earth).y

  travel = rand(6) ' Departure from Earth

  ship_state = state_turned

  next_planet = mercury



  ' Initial camera and floating cursor

  camera_x = half(hex_center_x(ship_pos.x, ship_pos.y) + hex_center_x(planet_pos(next_planet).x, planet_pos(next_planet).y))

  camera_y = half(hex_center_y(ship_pos.x, ship_pos.y) + hex_center_y(planet_pos(next_planet).x, planet_pos(next_planet).y))

  cursor_pos(0).x = true ' Setting to true means next update, it will be set to goal instead of approaching goal

  cursor_pos(0).y = true



  play_game



  cy = 1

loop











' ===== Routine index =====



'--- Game mechanics ---

'play_game            ' Main game loop

'shuffle_deck        ' Shuffle a new deck with all cards not present in a player's hand

'fill_hand            ' Fill a player's hand, shuffling when necessary

'end_turn            ' Fill the current hand, then advance the turn counter

'f legal_move        ' Determine whether moving a given direction from a given position is allowed

'set_preset          ' Set the six preset locations for each planet

'set_planet          ' Set the position of a planet to one of its six presets



'--- Graphics ---

'draw_board          ' Draw all board and UI elements

'draw_cursor          ' Draw the red arrow cursor and trail

'draw_sprite          ' Draw a specified animation frame of a sprite at a given position on screen

'display_screen      ' Display the main screen in hardware mode, accounting for window size option

'capture_screen      ' Copy the contents of the screen for later use

'restore_screen      ' Put the stored screen contents back on the screen

'clear_image          ' Fill an image surface with a given color

'play_sound          ' Play a sound effect by name



'--- Shorthand and conversion ---

'f compass$          ' Convert a numerical direction to compass direction text

'f text_replace$      ' Search a string for instances of a given piece, and replace all with another piece

'f hex_center_x      ' Take board coordinates and return display coordinates of center of hex cell,

'f hex_center_y      '    relative to board center at 14, 15

'f size_x            ' Return the visual dimensions of a sprite

'f size_y



'--- Files and data handling ---

'mfi_loader          ' Load the archived resource file, containing images and sounds

'f load_gfx&          ' Retrieve an image from the loaded resource file and return its handle

'f load_sfx&          ' Retrieve a sound from the loaded resource file and return its handle

'load_settings        ' Load any existing settings file, otherwise create one from defaults

'save_settings        ' Save settings to a file

'parse_sprites        ' Scan a sprite sheet for sprite positions and dimensions, using detection pixels

'set_sprite_ref      ' Set references to sprites found in sheets in sequence, using named constants











' ------------------------------------

' ========== Game mechanics ==========

' ------------------------------------



sub play_game



cx = 1

do

  ' Game over check

  if fuel_tanks <= 0 and deck_size <= 0 then

      ' Iterate through each player's hand, if any possible action is found, it's not a game over

      game_over = true

      for p = 1 to player_count

        for c = 1 to hand_size(p)

            v = hand(p, c)

            a_move    = true

            a_shall_l = true

            a_shall_r = true

            a_sharp_l = true

            a_sharp_r = true

            a_depart  = true



            if ship_state = state_landed then a_move = false

            for n = 1 to v

              dx = ship_pos.x + (move_delta(travel).x * n)

              dy = ship_pos.y + (move_delta(travel).y * n)

              if legal_move(dx, dy, travel) = false        then a_move = false: exit for

              if n < v and planet_at(dx, dy) = next_planet then a_move = false: exit for

            next n



            d = wrap(travel - 1, 1, 6): a_shall_l = legal_move(ship_pos.x + move_delta(d).x, ship_pos.y + move_delta(d).y, d)

            d = wrap(travel + 1, 1, 6): a_shall_r = legal_move(ship_pos.x + move_delta(d).x, ship_pos.y + move_delta(d).y, d)

            d = wrap(travel - 2, 1, 6): a_sharp_l = legal_move(ship_pos.x + move_delta(d).x, ship_pos.y + move_delta(d).y, d)

            d = wrap(travel + 2, 1, 6): a_sharp_r = legal_move(ship_pos.x + move_delta(d).x, ship_pos.y + move_delta(d).y, d)

            if ship_state <> state_moved then a_shall_l = false: a_shall_r = false: a_sharp_l = false: a_sharp_r = false

            if v < 5 then a_shall_l = false: a_shall_r = false

            if v < 3 or v = 5 then a_sharp_l = false: a_sharp_r = false



            if ship_state <> state_landed then a_depart = false

            if dir_used(ship_pos.x, ship_pos.y, v) = true then a_depart = false ' Departing in the same direction landed



            if a_move + a_shall_l + a_shall_r + a_sharp_l + a_sharp_r + a_depart <> false then game_over = false: exit for

        next c

        if game_over = false then exit for

      next p



      if game_over = true then

        topx = -screenw: botx = screenw: xstep = 16: h = inthalf(screenh)

        for frame = 1 to 130

            limit 60

            draw_board cx

            line(0, 0)-(screenw, screenh), rgba32(0, 0, 0, (frame / 130) * 255), bf

            if frame <= 40 then topx = topx + xstep

            if frame > 40 and frame <= 80 then botx = botx - xstep

            putimage(topx, 0)-step(screenw - 1, h - 1), gameover_image, full_screen, (0, 0)-step(screenw - 1, h - 1)

            putimage(botx, h)-step(screenw - 1, h - 1), gameover_image, full_screen, (0, h)-step(screenw - 1, h - 1)

            display_screen

        next frame



        do

            limit 60

            display_screen

            k$ = inkey$

        loop until k$ = ""

        do

            limit 60

            display_screen

            k$ = inkey$

        loop while k$ = ""



        exit sub

      end if

  end if



  s = sprite_ref(spr_card_large)

  cursor_goal.x = hand_ox(turn, spr_card_large) + inthalf(size_x(s)) + (hand_offset(spr_card_large) * (cx - 1))

  cursor_goal.y = hand_oy(turn, spr_card_large) + size_y(s) - inthalf(size_y(sprite_ref(spr_cursor))) + (int(size_y(s) * 0.2) * -sgn(turn - 2.5))



  do

      limit 60

      draw_board cx

      draw_cursor

      display_screen

      k$ = inkey$

  loop while k$ = ""



  menu_end = hand_size(turn) + 1

  if hand_size(turn) => 3 then l = hand_size(turn) else l = menu_end

  if k$ = arrow(left)  then play_sound sfx_card: cx = wrap(cx - 1, 1, l)

  if k$ = arrow(right) then play_sound sfx_card: cx = wrap(cx + 1, 1, l)



  if k$ = chr$(27) then

      play_sound sfx_menu_move

      ' Quit confirmation

      t$ = "END GAME IN PROGRESS? (Y/N)"

      w = inthalf(text_width(t$, f_gaia_red))

      h = inthalf(g_font(f_gaia_red, 0).h)

      margin = 10

      do

        limit 60

        draw_board cx

        set_font f_gaia_red, center_align, full_screen

        line(inthalf(screenw) - w - margin, inthalf(screenh) - h - margin)-(inthalf(screenw) + w + margin, inthalf(screenh) + h + margin), rgba32( 0,  0,  0, 255), bf

        line(inthalf(screenw) - w - margin, inthalf(screenh) - h - margin)-(inthalf(screenw) + w + margin, inthalf(screenh) + h + margin), rgba32(11, 148, 217, 255), b

        glass_fonts t$, inthalf(screenw), inthalf(screenh) - h

        display_screen

        k$ = lcase$(inkey$)

      loop while k$ = ""

      play_sound sfx_menu_confirm

      if k$ = "y" then exit sub else continue

  end if



  if k$ <> chr$(13) and k$ <> " " then continue



  ' Selection confirmed



  if cx = menu_end then end_turn: cx = 1: continue



  play_sound sfx_menu_confirm



  ' Prepare action menu



  v = hand(turn, cx)



  a_move    = true

  a_shall_l = true

  a_shall_r = true

  a_sharp_l = true

  a_sharp_r = true

  a_depart  = true

  a_discard = true



  ' Action conditions



  if ship_state = state_landed then a_move = false

  for n = 1 to v

      dx = ship_pos.x + (move_delta(travel).x * n)

      dy = ship_pos.y + (move_delta(travel).y * n)

      if legal_move(dx, dy, travel) = false        then a_move = false: exit for

      if n < v and planet_at(dx, dy) = next_planet then a_move = false: exit for

  next n



  d = wrap(travel - 1, 1, 6): a_shall_l = legal_move(ship_pos.x + move_delta(d).x, ship_pos.y + move_delta(d).y, d)

  d = wrap(travel + 1, 1, 6): a_shall_r = legal_move(ship_pos.x + move_delta(d).x, ship_pos.y + move_delta(d).y, d)

  d = wrap(travel - 2, 1, 6): a_sharp_l = legal_move(ship_pos.x + move_delta(d).x, ship_pos.y + move_delta(d).y, d)

  d = wrap(travel + 2, 1, 6): a_sharp_r = legal_move(ship_pos.x + move_delta(d).x, ship_pos.y + move_delta(d).y, d)

  if ship_state <> state_moved then a_shall_l = false: a_shall_r = false: a_sharp_l = false: a_sharp_r = false

  if v < 5 then a_shall_l = false: a_shall_r = false

  if v < 3 or v = 5 then a_sharp_l = false: a_sharp_r = false



  if ship_state <> state_landed then a_depart = false

  if dir_used(ship_pos.x, ship_pos.y, v) = true then a_depart = false ' Departing in the same direction landed



  if hand_size(turn) < 3 then a_discard = false



  ' Menu positions



  total_a = 0

  if a_move    = true then total_a = total_a + 1: a_move    = total_a

  if a_shall_l = true then total_a = total_a + 1: a_shall_l = total_a

  if a_shall_r = true then total_a = total_a + 1: a_shall_r = total_a

  if a_sharp_l = true then total_a = total_a + 1: a_sharp_l = total_a

  if a_sharp_r = true then total_a = total_a + 1: a_sharp_r = total_a

  if a_depart  = true then total_a = total_a + 1: a_depart  = total_a

  if a_discard = true then total_a = total_a + 1: a_discard = total_a

  if total_a = 0 then continue



  a_ox = 60: a_oy = 2

  cx2 = 1



  do

      do

        limit 60

        draw_board cx



        x = 2

        if turn mod 2 = 0 then x = screenw - (x_offset * (total_a + 1)) - (y_offset - x_offset) - 2

        y = hand_oy(1, spr_card_large) + size_y(sprite_ref(spr_card_large)) + 3

        if turn > 2 then y = hand_oy(3, spr_card_large) - y_offset - inthalf(y_offset) - 2



        y1 = 0

        for n = 1 to total_a

            select case n

              case a_move:    s = sprite_ref(spr_iconx_move):      m = travel

              case a_shall_l: s = sprite_ref(spr_iconx_turnsoftl): m = travel

              case a_shall_r: s = sprite_ref(spr_iconx_turnsoftr): m = travel

              case a_sharp_l: s = sprite_ref(spr_iconx_turnhardl): m = travel

              case a_sharp_r: s = sprite_ref(spr_iconx_turnhardr): m = travel

              case a_depart:  s = sprite_ref(spr_iconx_depart):    m = v

              case a_discard: s = sprite_ref(spr_iconx_discard):  m = 1

            end select

            if n = cx2 then s = s + 1

            draw_sprite s, m, x, y + y1



            ' Cursor

            if n = cx2 then cursor_goal.x = x + inthalf(y_offset): cursor_goal.y = y + y1 + 28



            x = x + x_offset + 1

            y1 = toggle(y1, 0, inthalf(y_offset)) ' Stagger hexes up and down

        next n



        select case cx2

            case a_move:    t$ = "Move forward"

            case a_shall_l: t$ = "Shallow left turn"

            case a_shall_r: t$ = "Shallow right turn"

            case a_sharp_l: t$ = "Sharp left turn"

            case a_sharp_r: t$ = "Sharp right turn"

            case a_depart:  t$ = "Launch"

            case a_discard: t$ = "Discard other cards"

        end select

        set_font f_loxica, center_align, full_screen

        w = inthalf(text_width(t$, f_loxica))

        margin = 5

        line(inthalf(screenw) - w - margin, margin)-(inthalf(screenw) + w + margin, (margin * 3) + g_font(font_using, 0).h), rgba32( 0,  0,  0, 255), bf

        line(inthalf(screenw) - w - margin, margin)-(inthalf(screenw) + w + margin, (margin * 3) + g_font(font_using, 0).h), rgba32(11, 148, 217, 255), b

        glass_fonts t$, inthalf(screenw), margin * 2



        draw_cursor



        display_screen

        k$ = inkey$

      loop while k$ = ""



      if k$ = arrow(left)  then play_sound sfx_menu_move: cx2 = wrap(cx2 - 1, 1, total_a)

      if k$ = arrow(right) then play_sound sfx_menu_move: cx2 = wrap(cx2 + 1, 1, total_a)

      if k$ = chr$(27) then play_sound sfx_menu_move: exit do



      if k$ <> chr$(13) and k$ <> " " then continue



      ' Selection confirmed



      if cx2 <> a_discard then actions_taken(turn) = actions_taken(turn) + 1



      select case cx2

        case a_shall_l

            play_sound sfx_thruster

            travel = wrap(travel - 1, 1, 6)

        case a_shall_r

            play_sound sfx_thruster

            travel = wrap(travel + 1, 1, 6)

        case a_sharp_l

            play_sound sfx_thruster

            travel = wrap(travel - 2, 1, 6)

        case a_sharp_r

            play_sound sfx_thruster

            travel = wrap(travel + 2, 1, 6)



        case a_depart

            play_sound sfx_takeoff

            travel = v



        case a_discard

            hand(turn, 1) = v

            hand_size(turn) = 1

            cx = 1

            end_turn



        case a_move

            distance_traveled = distance_traveled + v

            for n = 1 to v

              dir_used(ship_pos.x, ship_pos.y, travel) = true

              ship_pos.x = ship_pos.x + move_delta(travel).x

              ship_pos.y = ship_pos.y + move_delta(travel).y

              dir_used(ship_pos.x, ship_pos.y, wrap(travel + 3, 1, 6)) = true

            next n

            ship_state = state_moved

            if planet_at(ship_pos.x, ship_pos.y) = next_planet then

              play_sound sfx_landing

              cursor_pos(0).x = true: cursor_pos(0).y = true



              ' Landing Successful overlay animation

              topx = -screenw: botx = screenw: xstep = 16: h = inthalf(screenh)

              for frame = 1 to 210

                  limit 60

                  draw_board cx

                  if frame <= 40 then topx = topx + xstep

                  if frame > 40 and frame <= 80 then botx = botx - xstep

                  if frame > 170 then topx = topx + xstep: botx = botx - xstep

                  if next_planet = earth and frame => 80 then exit for

                  putimage(topx, 0)-step(screenw - 1, h - 1), landing_image(next_planet), full_screen, (0, 0)-step(screenw - 1, h - 1)

                  putimage(botx, h)-step(screenw - 1, h - 1), landing_image(next_planet), full_screen, (0, h)-step(screenw - 1, h - 1)

                  display_screen

              next frame



              ' Victory animation continues

              if next_planet = earth then

                  draw_board cx

                  capture_screen

                  y = 0

                  for frame = 1 to 130

                    limit 60

                    if frame > 40 and frame <= 85 then y = y - 2

                    restore_screen

                    line(0, 0)-(screenw, screenh), rgba32(0, 0, 0, (frame / 130) * 255), bf

                    putimage(0, y), landing_image(earth), full_screen

                    display_screen

                  next frame

                  cls , rgba32(0, 0, 0, 255)

                  putimage(0, y), landing_image(earth), full_screen

                  display_screen



                  font_using = f_gaia_blue

                  w = inthalf(text_width("DISTANCE TRAVELED:" + str$(distance_traveled), font_using))

                  h = g_font(font_using, 0).h

                  y = inthalf(screenh) + h



                  for frame = 1 to 60: limit 60: display_screen: next frame

                  set_font f_gaia_blue, left_align, full_screen

                  glass_fonts "FUEL REMAINING:", inthalf(screenw) - w, y

                  set_font f_gaia_red, right_align, full_screen

                  glass_fonts str$(fuel_tanks), inthalf(screenw) + w, y

                  y = y + h



                  for frame = 1 to 60: limit 60: display_screen: next frame

                  set_font f_gaia_blue, left_align, full_screen

                  glass_fonts "DISTANCE TRAVELED:", inthalf(screenw) - w, y

                  set_font f_gaia_red, right_align, full_screen

                  glass_fonts str$(distance_traveled), inthalf(screenw) + w, y

                  y = y + h



                  for frame = 1 to 60: limit 60: display_screen: next frame

                  set_font f_gaia_blue, left_align, full_screen

                  glass_fonts "TOTAL MOVES:", inthalf(screenw) - w, y

                  set_font f_gaia_red, right_align, full_screen

                  glass_fonts str$(actions_taken(1) + actions_taken(2) + actions_taken(3) + actions_taken(4)), inthalf(screenw) + w, y



                  do

                    limit 60

                    display_screen

                    k$ = inkey$

                  loop until k$ = ""

                  do

                    limit 60

                    display_screen

                    k$ = inkey$

                  loop while k$ = ""

                  exit sub

              end if



              next_planet = next_planet + 1

              ship_state = state_landed

            else

              play_sound sfx_rocket ' No planet landing, just normal move forward

            end if

      end select



      if cx2 <> a_move and cx2 <> a_discard then ship_state = state_turned



      if cx2 <> a_discard then

        hand_size(turn) = hand_size(turn) - 1

        for n = cx to hand_size(turn)

            hand(turn, n) = hand(turn, n + 1)

        next n

      end if



      exit do

  loop



  cx = min(cx, hand_size(turn))

  if hand_size(turn) <= 0 then cx = 1: end_turn

loop



end sub





sub shuffle_deck



dim card_count(6) as byte

for p = 1 to player_count: for c = 1 to hand_size(p)

  card_count(hand(p, c)) = card_count(hand(p, c)) + 1

next c: next p



sorting_count = 0

for n = 1 to 6: for c = card_count(n) + 1 to 4

  sorting_count = sorting_count + 1

  sorting(sorting_count).s_index = n

next c: next n

shuffle

for n = 1 to sorted_count(1): deck(n) = sorted(1, n).s_index: next n

deck_size = sorted_count(1)



fuel_tanks = fuel_tanks - 1



end sub





sub fill_hand(p)

do while hand_size(p) < 3

  if deck_size <= 0 and fuel_tanks > 0 then shuffle_deck

  if deck_size <= 0 and fuel_tanks <= 0 then exit sub

  hand_size(p) = hand_size(p) + 1

  hand(p, hand_size(p)) = deck(deck_size)

  deck_size = deck_size - 1

loop

end sub





sub end_turn

if 3 - hand_size(turn) >  deck_size and hand_size(turn) > 0 then play_sound sfx_shuffle

if 3 - hand_size(turn) <= deck_size and hand_size(turn) > 0 then play_sound sfx_card

fill_hand(turn)

turn = wrap(turn + 1, 1, player_count)

end sub





function legal_move(x, y, d)

legal_move = true

if valid_cell(x, y) = false then legal_move = false

if dir_used(x, y, wrap(d + 3, 1, 6)) = true then legal_move = false

p = planet_at(x, y)

if p <> false and p <> next_planet then legal_move = false

end function





sub set_preset(i, x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6, n$)

planet_name$(i) = n$

planet_preset(i, 1).x = x1: planet_preset(i, 1).y = y1

planet_preset(i, 2).x = x2: planet_preset(i, 2).y = y2

planet_preset(i, 3).x = x3: planet_preset(i, 3).y = y3

planet_preset(i, 4).x = x4: planet_preset(i, 4).y = y4

planet_preset(i, 5).x = x5: planet_preset(i, 5).y = y5

planet_preset(i, 6).x = x6: planet_preset(i, 6).y = y6

end sub





sub set_planet(p, v)

planet_at( planet_preset(p, v).x, planet_preset(p, v).y) = p

valid_cell(planet_preset(p, v).x, planet_preset(p, v).y) = true

planet_pos(p).x = planet_preset(p, v).x

planet_pos(p).y = planet_preset(p, v).y

end sub











' ------------------------------

' ========== Graphics ==========

' ------------------------------



sub draw_board(cx)



boundw = 366 ' Size of camera bounding box

boundh = 320 ' (This can be made to auto-adjust later if desired)



nextx = hex_center_x(planet_pos(next_planet).x, planet_pos(next_planet).y)

nexty = hex_center_y(planet_pos(next_planet).x, planet_pos(next_planet).y)

shipx = hex_center_x(ship_pos.x, ship_pos.y)

shipy = hex_center_y(ship_pos.x, ship_pos.y)



' Find camera destination



camx = half(shipx + nextx) ' Start between ship and next planet

camy = half(shipy + nexty)

camx = min(max(camx, shipx - half(boundw)), shipx + half(boundw)) ' Move camera if ship is outside bounding box

camy = min(max(camy, shipy - half(boundh)), shipy + half(boundh)) '  (Don't need to do this for next planet)



' Camera's actual position approaches destination



if abs(camx - camera_x) <= 0.6 then camera_x = camx ' Prevent very delayed last pixel of camera movement

if abs(camy - camera_y) <= 0.6 then camera_y = camy

camera_x = camera_x + ((camx - camera_x) * 0.2)

camera_y = camera_y + ((camy - camera_y) * 0.2)



' --- Background ---



putimage(0, 0), background_image, full_screen, (inthalf(width(background_image) - screenw) - (camera_x * 0.2),_

inthalf(height(background_image) - screenh) - (camera_y * 0.2))-step(screenw - 1, screenh - 1)



' --- Board ---



' Sun

s = sprite_ref(spr_sun)

x = inthalf(screenw) + hex_center_x(14, 15) - inthalf(size_x(s)) - camera_x

y = inthalf(screenh) + hex_center_y(14, 15) - inthalf(size_y(s)) - camera_y

draw_sprite s, 1, x, y



' Asteroids

randomize using asteroid_seed ' Fixed seed for consistent asteroid variations

for x1 = 0 to boardw: for y1 = 0 to boardh

  if planet_at(x1, y1) <> true then continue

  s = sprite_ref(spr_asteroid) + rand(4) - 1

  x = inthalf(screenw) + hex_center_x(x1, y1) - inthalf(size_x(s)) - camera_x

  y = inthalf(screenh) + hex_center_y(x1, y1) - inthalf(size_y(s)) - camera_y

  draw_sprite s, 1, x, y

next y1: next x1



' Planets

for p = 1 to 9

  s = sprite_ref(spr_planet) + p - 1

  x = inthalf(screenw) + hex_center_x(planet_pos(p).x, planet_pos(p).y) - inthalf(size_x(s)) - camera_x

  y = inthalf(screenh) + hex_center_y(planet_pos(p).x, planet_pos(p).y) - inthalf(size_y(s)) - camera_y

  draw_sprite s, 1, x, y

next p



' Hex grid

putimage(inthalf(screenw) + hex_center_x(1, -1) - inthalf(y_offset) - camera_x,_

inthalf(screenh) + hex_center_y(1, -1) - camera_y), grid_image, full_screen



' Path segments

for x = 0 to boardw: for y = 0 to boardh: for d = 1 to 6

  if dir_used(x, y, d) = false then continue

  s = sprite_ref(spr_path)

  x1 = inthalf(screenw) + hex_center_x(x, y) - inthalf(size_x(s)) - camera_x

  y1 = inthalf(screenh) + hex_center_y(x, y) - inthalf(size_y(s)) - camera_y

  draw_sprite s, d, x1, y1

next d: next y: next x



' Next planet reticle

f = 6

reticle_flash = wrap(reticle_flash + 1, 0, (f * 2) - 1)

s = sprite_ref(spr_reticle)

p = next_planet

x = inthalf(screenw) + hex_center_x(planet_pos(p).x, planet_pos(p).y) - inthalf(size_x(s)) - camera_x

y = inthalf(screenh) + hex_center_y(planet_pos(p).x, planet_pos(p).y) - inthalf(size_y(s)) - camera_y

draw_sprite s, int(reticle_flash / f) + 1, x, y



' Ship

f = 4

ship_frame = wrap(ship_frame + 1, 0, (f * 6) - 1)

s = sprite_ref(spr_ship)

x = inthalf(screenw) + hex_center_x(ship_pos.x, ship_pos.y) - inthalf(size_x(s)) - camera_x

y = inthalf(screenh) + hex_center_y(ship_pos.x, ship_pos.y) - inthalf(size_y(s)) - camera_y

if ship_state <> state_landed then draw_sprite s + travel - 1, int(ship_frame / f) + 1, x, y



' --- UI ---



' Navigation guides

putimage(screenw - 86, inthalf(screenh) - 70), reference_image, full_screen



' Deck

x = 10: y = hand_oy(3, spr_card_large) - 10 - size_y(sprite_ref(spr_deck))

for c = 1 to deck_size: draw_sprite sprite_ref(spr_deck), 1, x + c, y - inthalf(c): next c



' Fuel label

y = y - 30

font_pos x, y

if fuel_tanks > 0 then

  set_font f_gaia_blue, left_align, full_screen

  glass_fonts_at "FUEL"

elseif fuel_tanks <= 0 and int(timer mod 2) = 0 then

  set_font f_gaia_red, left_align, full_screen

  glass_fonts_at "FUEL"

end if



' Fuel gauge

y = y - 10

s = sprite_ref(spr_fuel)

for n = 1 to fuel_tanks

  draw_sprite s, 1, x, y

  y = y - size_y(s) - 1

next n



' Player hands

for p = 1 to player_count

  if p = turn then s = spr_card_large else s = spr_card_small

  temp_size = hand_size(p)

  if p = turn and temp_size < 3 then temp_size = temp_size + 1

  for c = 1 to temp_size

      y = hand_oy(p, s)

      if p = turn and c = cx then y = y + (int(size_y(sprite_ref(s)) * 0.2) * -sgn(turn - 2.5))

      m = hand(p, c)

      if c > hand_size(p) then m = 7

      draw_sprite sprite_ref(s), m, hand_ox(p, s) + ((c - 1) * hand_offset(s)), y

  next c

next p



end sub





sub draw_cursor



' Update cursor trail

for n = trail_length to 1 step -1

  cursor_pos(n).x = cursor_pos(n - 1).x

  cursor_pos(n).y = cursor_pos(n - 1).y

next n



' Cursor

dx = cursor_goal.x - cursor_pos(0).x

dy = cursor_goal.y - cursor_pos(0).y

if cursor_pos(0).x = true or abs(dx) < 0.5 then cursor_pos(0).x = cursor_goal.x

if cursor_pos(0).y = true or abs(dy) < 0.5 then cursor_pos(0).y = cursor_goal.y

cursor_pos(0).x = cursor_pos(0).x + ((cursor_goal.x - cursor_pos(0).x) * 0.3)

cursor_pos(0).y = cursor_pos(0).y + ((cursor_goal.y - cursor_pos(0).y) * 0.3)



for n = trail_length to 0 step -1

  s = sprite_ref(spr_cursor_trail)

  if n = 0 then s = sprite_ref(spr_cursor)

  draw_sprite s, 1, cursor_pos(n).x - inthalf(size_x(s)), cursor_pos(n).y - inthalf(size_y(s))

next n



end sub





sub draw_sprite(s, f, x, y)

x1 = sprite(s).pos.x + ((f - 1) * (size_x(s) + 2)) ' Animation frame

putimage(x, y), sprite(s).image, full_screen, (x1, sprite(s).pos.y)-step(size_x(s), size_y(s))

end sub





sub display_screen



'preserve& = dest

'dest scaled_screen(option_window_size)



hardware_image = copyimage(full_screen, 33)

putimage(0, 0)-((screenw * option_window_size) - 1, (screenh * option_window_size) - 1), hardware_image

display

freeimage hardware_image



'dest preserve&



end sub





sub capture_screen

clear_image store_screen, rgba32(0, 0, 0, 255)

putimage(0, 0)-(screenw - 1, screenh - 1), full_screen, store_screen, (0, 0)-(screenw - 1, screenh - 1)

end sub





sub restore_screen

clear_image full_screen, rgba32(0, 0, 0, 255)

putimage(0, 0)-(screenw - 1, screenh - 1), store_screen, full_screen, (0, 0)-(screenw - 1, screenh - 1)

end sub





sub clear_image(d&, h~&)

preserve& = dest

dest d&

cls , h~&

dest preserve&

end sub





sub play_sound(s)



if s = false or option_sound = false or sfx(s, 1) = false then exit sub



' Count valid sounds at this index and select one randomly

c = 1

do until sfx(s, c + 1) = false: c = c + 1: loop

r = rand(c)

if sfx(s, r) <> false then sndplay sfx(s, r)



end sub











' ----------------------------------------------

' ========== Shorthand and conversion ==========

' ----------------------------------------------



function compass$(d)

select case d

  case 1: c$ = "north"

  case 2: c$ = "northeast"

  case 3: c$ = "southeast"

  case 4: c$ = "south"

  case 5: c$ = "southwest"

  case 6: c$ = "northwest"

end select

compass$ = c$

end function





function text_replace$(t1$, r1$, r2$)

' Search t$ for instances of r1$ and replace them with r2$

t$ = t1$

do while instr(t$, r1$) <> false

  t$ = left$(t$, instr(t$, r1$) - 1) + r2$ + right$(t$, len(t$) - (instr(t$, r1$) + len(r1$) - 1))

loop

text_replace$ = t$

end function





function hex_center_x(x, y)

' Take board coordinates and return display x of center of hex cell, relative to board center at 14, 15

z = y ' y parameter is to give these two functions the same syntax, avoid forgetting to omit y for this one

hex_center_x = (x - inthalf(boardw)) * x_offset

end function





function hex_center_y(x, y)

' Take board coordinates and return display y of center of hex cell, relative to board center at 14, 15

hex_center_y = ((y - inthalf(boardh)) * y_offset) - ((x - inthalf(boardw)) * inthalf(y_offset))

end function





function size_x(s)

size_x = sprite(s).size.x

end function





function size_y(s)

size_y = sprite(s).size.y

end function











' ---------------------------------------------

' ========== Files and data handling ==========

' ---------------------------------------------



sub mfi_loader(f$)



mfi = freefile



open f$ for binary as #mfi

get #mfi, , mfi_count

for i = 1 to mfi_count

  get #mfi, , mfi_o(i)

  get #mfi, , mfi_s(i)

  mfi_o(i) = mfi_o(i) + 1

next i



mfi_index = 1



' ----- Images -----



background_image = load_gfx(mfi)

grid_image      = load_gfx(mfi)

sprite_image    = load_gfx(mfi)

icon_image      = load_gfx(mfi)



g_font(f_loxica,    0).image = load_gfx(mfi)

g_font(f_gaia_blue, 0).image = load_gfx(mfi)

g_font(f_gaia_red,  0).image = load_gfx(mfi)

for n = 1 to fonts: initialize_font n: next



for n = 1 to 4: how_to_play_image(n) = load_gfx(mfi): next n

for n = 1 to 9: landing_image(n) = load_gfx(mfi): next n

gameover_image  = load_gfx(mfi)

reference_image  = load_gfx(mfi)



' ----- Sound effects -----



sfx(sfx_menu_move,    1) = load_sfx(mfi)

sfx(sfx_menu_confirm, 1) = load_sfx(mfi)

sfx(sfx_card,        1) = load_sfx(mfi)

sfx(sfx_shuffle,      1) = load_sfx(mfi)

sfx(sfx_rocket,      1) = load_sfx(mfi)

sfx(sfx_thruster,    1) = load_sfx(mfi)

sfx(sfx_landing,      1) = load_sfx(mfi)

sfx(sfx_takeoff,      1) = load_sfx(mfi)



if fileexists("mfi_temp.dat") then kill "mfi_temp.dat"



end sub





function load_gfx&(mfi)



if fileexists("mfi_temp.dat") then kill "mfi_temp.dat"

mfidata = freefile



open "mfi_temp.dat" for binary as #mfidata

dat$ = space$(mfi_s(mfi_index))

get #mfi, mfi_o(mfi_index), dat$

put #mfidata, , dat$



close #mfidata

load_gfx& = loadimage("mfi_temp.dat", 32)



mfi_index = mfi_index + 1



end function





function load_sfx&(mfi)



if fileexists("mfi_temp.dat") then kill "mfi_temp.dat"

mfidata = freefile



open "mfi_temp.dat" for binary as #mfidata

dat$ = space$(mfi_s(mfi_index))

get #mfi, mfi_o(mfi_index), dat$

put #mfidata, , dat$



close #mfidata

load_sfx& = sndopen("mfi_temp.dat")



mfi_index = mfi_index + 1



end function





sub load_settings



if fileexists("settings.ini") = false then save_settings: exit sub



open "settings.ini" for binary as #1

get #1, 1, option_sound

get #1, , option_window_size

close #1



' Reset invalid option states to default

if option_sound <> false then option_sound = true

if option_window_size < 1 or option_window_size > 3 then option_window_size = 2



end sub





sub save_settings



open "settings.ini" for binary as #1

put #1, 1, option_sound

put #1, , option_window_size

close #1



end sub





sub parse_sprites(i&)



preserve& = source

source i&



d~& = point(0, 0) ' Detection color

s = sprite_count + 1

x1 = 1 ' Top left of first sprite

y1 = 2



do

  sprite(s).image = i&



  ' Source position

  sprite(s).pos.x = x1

  sprite(s).pos.y = y1



  ' Sprite size

  x2 = scan_right(x1, y1, i&, d~&)

  y2 =  scan_down(x1, y1, i&, d~&)

  sprite(s).size.x = x2 - x1 - 1

  sprite(s).size.y = y2 - y1 - 1



  ' Animation frame count

  x2 = scan_right(x2, y1, i&, d~&)

  sprite(s).frames = int( ((x2 + 1) - x1) / (sprite(s).size.x + 2) )

  if sprite(s).frames < 1 then sprite(s).frames = 1



  ' Frame counter ticks per animation frame

  sprite(s).fpf = scan_right(x2, y1 - 1, i&, d~&) - x2

  if sprite(s).fpf < 1 then sprite(s).fpf = 1

  x2 = x2 + 1



  ' Sprite display position - relative to entity hitbox position

  x_hb = scan_right(x2 - 1, y1, i&, d~&)

  y_hb =  scan_down(x2, y1 - 1, i&, d~&)

  sprite(s).hb_offset.x = x2 - x_hb

  sprite(s).hb_offset.y = y1 - y_hb



  ' Hitbox size

  sprite(s).hb_size.x = scan_right(x_hb, y1, i&, d~&) - x_hb

  sprite(s).hb_size.y =  scan_down(x2, y_hb, i&, d~&) - y_hb



  y1 = y2 + 1

  if point(x1 - 1, y1) = d~& then ' End of column

      if point(x1, 0) = d~& then exit do ' No more columns

      y1 = 2

      x1 = scan_right(x1, 0, i&, d~&) + 1 ' Find new column

  end if



  s = s + 1

loop



sprite_count = s



source preserve&



end sub





sub set_sprite_ref



' ----- Set sprite references - must be in order found in image files -----



s = 1

sprite_ref(spr_card_large)      = s: s = s + 1

sprite_ref(spr_card_small)      = s: s = s + 1

sprite_ref(spr_deck)            = s: s = s + 1

sprite_ref(spr_cursor)          = s: s = s + 1

sprite_ref(spr_cursor_trail)    = s: s = s + 1



sprite_ref(spr_path)            = s: s = s + 1

sprite_ref(spr_ship)            = s: s = s + 6



sprite_ref(spr_planet)          = s: s = s + 9

sprite_ref(spr_sun)            = s: s = s + 1

sprite_ref(spr_asteroid)        = s: s = s + 4



sprite_ref(spr_fuel)            = s: s = s + 1

sprite_ref(spr_reticle)        = s: s = s + 1



sprite_ref(spr_iconx_move)      = s: s = s + 1

sprite_ref(spr_icono_move)      = s: s = s + 1

sprite_ref(spr_iconx_turnsoftl) = s: s = s + 1

sprite_ref(spr_icono_turnsoftl) = s: s = s + 1

sprite_ref(spr_iconx_turnsoftr) = s: s = s + 1

sprite_ref(spr_icono_turnsoftr) = s: s = s + 1

sprite_ref(spr_iconx_turnhardl) = s: s = s + 1

sprite_ref(spr_icono_turnhardl) = s: s = s + 1

sprite_ref(spr_iconx_turnhardr) = s: s = s + 1

sprite_ref(spr_icono_turnhardr) = s: s = s + 1

sprite_ref(spr_iconx_depart)    = s: s = s + 1

sprite_ref(spr_icono_depart)    = s: s = s + 1

sprite_ref(spr_iconx_discard)  = s: s = s + 1

sprite_ref(spr_icono_discard)  = s: s = s + 1



end sub





' Math and logic routines



' No data structure or dependencies





function plus_limit(n, p, l) ' p is added to n, but can't go past l in the direction of travel

q = n + p

if sgn(q - l) = sgn(p) then q = l

plus_limit = q

end function





function half(n) ' less expensive than n / 2, less parentheses than n * 0.5

half = n * 0.5

end function

function inthalf(n) ' same, but with int() around it

inthalf = int(n * 0.5)

end function





function sq(n) ' less expensive and less parentheses than n ^ 2

' For code clarity

sq = n * n

end function





function atn1(n) ' shortcut for getting radians of eight cardinals and diagonals

' For code clarity - n represents multiple of 45 degrees, or quarter-pi radians

atn1 = n * atn(1)

end function





function degrees(d) ' pass in degrees, returns radians

degrees = atn1(d / 45)

end function





function hypo(a, b) ' pass in triangle legs, returns hypotenuse (Pythagoras)

hypo = sqr(sq(a) + sq(b)) ' squares are always positive, so no danger of imaginary component

end function





function arctan(y, x) ' atn() with safety checks, and sensitive to negative axes

arctan = 0

if x = 0 and y = 0 then exit function

a = atn1(2)

if x <> 0 then ' prevent division by zero

  a = abs(atn(y / x))

  if x < 0 then a = atn1(4) - a

end if

if y < 0 then a = flip_y(a)

arctan = a

end function





function flip_x(a) ' flips angle left/right

flip_x = wrap_a( (atn1(8) - wrap_a(a + atn1(2))) - atn1(2) )

end function

function flip_y(a) ' flips angle up/down

flip_y = atn1(8) - a

end function





function frames(s) ' pass a decimal as seconds.frames, returns integer frames

f = int(s) * 60

frames = int(f + ((s - int(s)) * 100))

end function





function frames_dec(s) ' like frames(), but takes seconds.decimal instead of seconds.frames,

f = int(s) * 60        ' so 0.50 will return 30 frames, not 50 frames

frames_dec = int(f + ((s - int(s)) * 60))

end function





function wrap(n, l1, h1) ' n is adjusted back within lower(l) and upper(h) bounds similar to mod operator

l = l1: h = h1 ' make sure h is never less than l, this also prevents division by zero

if h1 < l1 then

  l = h1: h = l1

end if

x = (l - n) / ((h - l) + 1)

if x <> int(x) then x = x + 1

wrap = n + (int(x) * ((h - l) + 1))

end function





function wrap_a(a) ' angle a is adjusted back within 0 and 2pi, noninclusive of 2pi

x = -a / atn1(8)

if x <> int(x) then x = x + 1

wrap_a = a + (int(x) * atn1(8))

end function





function toggle(v, p, q)

if v = p then toggle = q

if v = q then toggle = p

end function





function rounding(n) ' rounds to closer integer

p = int(n)

if mod_dec(n, 1) => 0.5 then p = p + 1

rounding = p

end function





function min(n1, n2)

if n2 < n1 then min = n2 else min = n1

end function





function max(n1, n2)

if n2 > n1 then max = n2 else max = n1

end function





function pyr(n) ' produce pyramid number on n (1 + 2 + 3 ... n)

pyr = n * (n + 1) * 0.5

end function





function rand(n) ' produce random whole number from 1 to n

rand = int(rnd * n) + 1

end function





function mod_dec(n, d) ' mod operator that preserves decimal

mod_dec = n

if d = 0 then exit function ' Division by zero protection

mod_dec = ((n / d) - int(n / d)) * d

end function





function hexcolor~&(h$)

hexcolor~& = rgba32(0, 0, 0, 255)

if len(h$) <> 6 then exit function

hexcolor~& = rgba32(val("&H" + mid$(h$, 1, 2)), val("&H" + mid$(h$, 3, 2)), val("&H" + mid$(h$, 5, 2)), 255)

end function





function before$(t$, c$)

p = instr(t$, c$)

if p = false then p = len(t$) + 1

before$ = left$(t$, p - 1)

end function





function after$(t$, c$)

after$ = right$(t$, len(t$) - instr(t$, c$) - (len(c$) - 1))

end function





function between$(t$, c1$, c2$)

between$ = before$(after$(t$, c1$), c2$)

end function





function vector_x(a, v) ' convert polar vector to x component

vector_x = 0

if a = aim_n or a = aim_s then exit function ' Protect against undefined cos()

vector_x = v * cos(a)

end function

function vector_y(a, v) ' convert polar vector to y component

vector_y = 0

if a = aim_w or a = aim_e then exit function ' Protect against undefined sin()

vector_y = v * sin(a)

end function





function ellipse_focus_x(axis_x, axis_y)

ellipse_focus_x = 0

if axis_x > axis_y then ellipse_focus_x = sqr(sq(axis_x) - sq(axis_y))

end function

function ellipse_focus_y(axis_x, axis_y)

ellipse_focus_y = 0

if axis_x < axis_y then ellipse_focus_y = sqr(sq(axis_y) - sq(axis_x))

end function





function x_on_ellipse(ax, ay, angle)



select case angle

  case atn1(0): ex = ax

  case atn1(4): ex = ax

  case atn1(2): ex = 0

  case atn1(6): ex = 0

  case else: ex = (ax * ay) / sqr(sq(ay) + sq(ax * tan(angle)))

end select



if angle > atn1(2) and angle < atn1(6) then ex = -ex

x_on_ellipse = ex



end function





function y_on_ellipse(ax, ay, angle)



select case angle

  case atn1(0): ey = 0

  case atn1(4): ey = 0

  case atn1(2): ey = ay

  case atn1(6): ey = ay

  case else: ey = (ax * ay) / sqr(sq(ax) + sq(ay / tan(angle)))

end select



if angle > atn1(4) then ey = -ey

y_on_ellipse = ey



end function





function ellipse_tangent(ax, ay, angle)



' ax and ay are axis lengths from center of ellipse

' angle is from center of ellipse

' Returns tangent angle, facing in clockwise direction



' Point angle intersects ellipse

ix = x_on_ellipse(ax, ay, angle)

iy = y_on_ellipse(ax, ay, angle)



' Focus distance from center

fx = ellipse_focus_x(ax, ay)

fy = ellipse_focus_y(ax, ay)



' Angles from foci to intersection point

a1 = arctan(iy + fy, ix + fx)

a2 = arctan(iy - fy, ix - fx)



' Average, then right angle to get tangent angle

ellipse_tangent = wrap_a(half(a1 + a2) + atn1(2))



end function





function line_and_ellipse(x1, y1, x2, y2, axis_x, axis_y, ix, iy)



' Given a line between points (x1, y1) and (x2, y2) relative to an ellipse's center,

' find the x coordinate of the intersection between the line and the ellipse,

' closer to (x1, y1), and put output in (ix, iy).



ix = 0 ' Default to center of ellipse

iy = 0

line_and_ellipse = true ' Becomes false later if the quadratic's radical is negative



if axis_x = 0 and axis_y = 0 then exit function



fx = ellipse_focus_x(axis_x, axis_y)

fy = ellipse_focus_y(axis_x, axis_y)



dx = sgn(x2 - x1)

dy = sgn(y2 - y1)



' Handle pure vertical and horizontal

if dx = 0 or dy = 0 then

  ix = x1

  iy = y1

  if dx = 0 and dy <> 0 and axis_x > 0 then

      iy = -dy * sqr((sq(axis_y) * abs(sq(axis_x) - sq(x1))) / sq(axis_x))

  end if

  if dy = 0 and dx <> 0 and axis_y > 0 then

      ix = -dx * sqr((sq(axis_x) * abs(sq(axis_y) - sq(y1))) / sq(axis_y))

  end if



' Otherwise, run quadratic solution of line and ellipse

else

  slope = (y2 - y1) / (x2 - x1)

  elevation = y1 - (slope * x1)



  ' Quadratic coefficients

  a = sq(axis_x * slope) + sq(axis_y)

  b = 2 * sq(axis_x) * slope * elevation

  c = sq(axis_x) * (sq(elevation) - sq(axis_y))



  if sq(b) - (4 * a * c) < 0 then

      line_and_ellipse = false ' Negative will fail the quadratic radical,

      exit function            ' calling routine must be alerted

  end if



  ' Use x coordinate closer to (x1, y1)

  ix1 = quadratic(a, b, c,  1)

  ix2 = quadratic(a, b, c, -1)

  if abs(x1 - ix1) < abs(x1 - ix2) then ix = ix1 else ix = ix2



  iy = (slope * ix) + elevation

end if



end function





function quadratic(a, b, c, pm)

' pm is 1 or -1, to represent the +/- in the quadratic formula

if a = 0 then

  print "Quadratic denominator was zero!"

  display: sleep

  exit function

end if

quadratic = (-b + (pm * sqr(sq(b) - (4 * a * c)))) / (2 * a)

end function





' Insertion sort and sequence shuffle



' No dependencies







sub sort(s, d)



' Before calling, put key values in sorting().s_index, .s_value, and sorting_count

' Takes s_index and s_value in sorting(), sorts them into sorted(s, ) by s_value, in direction of sgn(d)



' So if d = 1, values will go up as sorted() index goes up, -1 is reverse



c = 1

sorted(s, 1).s_index = sorting(1).s_index

sorted(s, 1).s_value = sorting(1).s_value



for n1 = 2 to sorting_count ' sorting() index being inserted

  for n2 = 1 to c + 1 ' position in sorted(s, ) being checked



      if n2 > c or sgn(sorted(s, n2).s_value - sorting(n1).s_value) = sgn(d) then

        for n3 = c to n2 step -1 ' make space for insertion

            sorted(s, n3 + 1).s_index = sorted(s, n3).s_index

            sorted(s, n3 + 1).s_value = sorted(s, n3).s_value

        next n3



        sorted(s, n2).s_index = sorting(n1).s_index

        sorted(s, n2).s_value = sorting(n1).s_value

        c = c + 1

        exit for

      end if



  next n2

next n1

sorted_count(s) = c



end sub





sub shuffle



randomize timer

sorted_count(1) = 0

c = sorting_count



for n = 1 to c

  s = int(rnd * sorting_count) + 1

  sorted_count(1) = sorted_count(1) + 1

  sorted(1, sorted_count(1)).s_index = sorting(s).s_index



  sorting_count = sorting_count - 1

  for n1 = s to sorting_count

      sorting(n1).s_index = sorting(n1 + 1).s_index

  next n1

next n



end sub





' Glass Fonts - custom pixel font processing and drawing



' NOTE: Number of fonts, image handle assignment, and initialize_font calls must be done in main program.

'      Set fonts constant, then $include, then set image handles, then call initialize_font for each.







sub glass_fonts(t1$, x1, y1)

' Text, font, destination image surface, position, alignment



t$ = t1$

carriage = true

if right$(t$, 1) = ";" then

  carriage = false

  t$ = left$(t$, len(t$) - 1)

end if



x = x1: y = y1

f = font_using



if font_align <> left_align then

  ' Adjust starting point based on line width, for center or right align

  w = text_width(t$, f)

  if font_align = center_align then w = int(w * 0.5)

  x = x - w

end if



for n = 1 to len(t$)

  c = asc(mid$(t$, n, 1))

  w = g_font(f, c).w

  putimage(x, y)-step(w, g_font(f, 0).h), g_font(f, 0).image, font_dest, (g_font(f, c).pos.x, g_font(f, c).pos.y)-step(w, g_font(f, 0).h)

  x = x + w + 1

next n



font_x = x1

font_y = y1

if carriage = false then font_x = x

if carriage = true  then font_y = y1 + g_font(f, 0).h



end sub





sub glass_fonts_at(t$)

glass_fonts t$, font_x, font_y

end sub





sub set_font(f, a, d&)



font_using = f

font_align = a

font_dest  = d&



end sub





sub font_pos(x, y)



font_x = x

font_y = y



end sub





sub initialize_font(f)



preserve& = source



source g_font(f, 0).image

clearcolor point(0, 0), g_font(f, 0).image

i& = g_font(f, 0).image

d~& = point(1, 0) ' Detection color



' Height

g_font(f, 0).h = scan_down(1, 2, i&, d~&) - 3



y = 0

for cy = 0 to 15

  y = scan_down(1, y, i&, d~&) + 1

  x = 1

  for cx = 0 to 15

      n = (cy * 16) + cx

      g_font(f, n).pos.x = x ' Source position

      g_font(f, n).pos.y = y

      x = scan_right(x, y, i&, d~&) + 1

      g_font(f, n).w = x - g_font(f, n).pos.x - 2 ' Variable width

  next cx

next cy



source preserve&



end sub





function font_height

font_height = g_font(font_using, 0).h

end function





function text_width(t$, f)

w = 0

for n = 1 to len(t$)

  w = w + g_font(f, asc(mid$(t$, n, 1))).w + 1

next n

text_width = w - 1

end function





function scan_right(x1, y, i&, d~&) ' Starting position (noninclusive), image, detection color

x = x1

preserve& = source

source i&

w = width(i&)

do

  x = x + 1

  if x > w then call scan_error(x, y, "right")

loop until point(x, y) = d~& or x > w

scan_right = x

source preserve&

end function





function scan_down(x, y1, i&, d~&)

y = y1

preserve& = source

source i&

h = height(i&)

do

  y = y + 1

  if y > h then call scan_error(x, y, "down")

loop until point(x, y) = d~& or y > h

scan_down = y

source preserve&

end function





sub scan_error(x, y, t$)

t1$ = "Moved " + t$ + " beyond image at" + str$(x) + "," + str$(y)

set_font f_kharon, left_align, full_screen

glass_fonts t1$, 0, 0

display: sleep

end sub

Maybe it's my setup or something, but when I submit a post, if it's not accepted by the system, 
the error message returned is not legible. It's in black on dark red background. Is there a setting I can change for this?    
(I don't know what my error was when I discovered this, as I couldn't read it).