TheBackShed.com

' =============================================================
'rr.bas - PicoDB + Model Railroad OS
' =============================================================
Option EXPLICIT
Option Default Float

' =============================================================
' PICODB ENGINE GLOBALS (Required for library.bas)
' =============================================================
option local variables 500
Dim Integer GLOBAL_MODE = 2 ' for option resolution 640x320, 320x240 16 colors
Dim Integer DBG_LVL = 3 ' 0=min; 1=min; 2=max
Dim Integer Is_LCD = 0
Const MAX_TBL = 5
Const MAX_FLD = 30
Const TYPE_STR = 1
Const TYPE_INT = 2
Const TYPE_FLOAT = 3
Const MAX_ENGINES = 5
Const MAX_RECS = 920 ' Tuned for HDMI Memory, no PSRAM (150 works)
Const MAX_CARS_PER_TRAIN = 15
Const MAX_PARKED_CARS = 20
Const MAX_GROUPS=5
Const MAX_SCRIPT_LINES=100
Const STOP_MARGIN = 24.0 ' pixels
Const SpriteSize = 22
Const HC_06 = 0

' =============================================================
' RGB121 (4bpp) HARDWARE SPRITE PALETTE
' Bit Layout: [Red] [Green_Hi] [Green_Lo] [Blue]
' =============================================================
Const HW_BLACK = 0 ' (0000) MMBasic 0
Const HW_BLUE = 1 ' (0001) MMBasic 1

Const HW_MYRTLE = 2 ' (0010) MMBasic 8 (Low Green)
Const HW_COBALT = 3 ' (0011) MMBasic 9
Const HW_MIDGREEN = 4 ' (0100) MMBasic 10 (High Green)
Const HW_CERULEAN = 5 ' (0101) MMBasic 11

Const HW_GREEN = 6 ' (0110) MMBasic 2 (Full Green)
Const HW_CYAN = 7 ' (0111) MMBasic 3

Const HW_RED = 8 ' (1000) MMBasic 4
Const HW_MAGENTA = 9 ' (1001) MMBasic 5

Const HW_BROWN = 10 ' (1010) MMBasic 14 (Red + Low Green)
Const HW_LILAC = 11 ' (1011) MMBasic 15
Const HW_RUST = 12 ' (1100) MMBasic 12 (Red + High Green)
Const HW_FUCHSIA = 13 ' (1101) MMBasic 13

Const HW_YELLOW = 14 ' (1110) MMBasic 6 (Red + Full Green)
Const HW_WHITE = 15 ' (1111) MMBasic 7

Const TransparentColor = HW_MAGENTA ' 9=magenta

Dim Float D_Scale
Dim Float D_CAR_GAP

' --- DISPLAY SETTINGS ---
Dim Float PARK_MARGIN
Dim Float CAR_WIDTH

Dim STRING dbname$ = "layout", db_command$
Dim STRING makedb_default$ = "make-db layout roster, segments index on location, sequence use"
Dim STRING cmd$, defLine$, token$, workLine$, tmp_f$
Dim INTEGER fNum, commaPos, tokIdx, startTime, tStart
Dim STRING temp_alias$, temp_file$, temp_owner$, temp_name$
Dim INTEGER temp_len, temp_type, temp_start, temp_width, spc

Dim STRING Q_Filter$, Q_OrderFld$, Q_ShowFlds$, Q_OutFile$
Dim INTEGER Q_Limit, Q_OrderDesc, Q_OutType, Q_OutHandle
Dim INTEGER Result_Count
Dim INTEGER Aggr_Mode, Aggr_Fld_ID, Aggr_Count, Action_Mode
Dim FLOAT Aggr_Val
Dim INTEGER SQL_Mode, CACHE_LOADED
Dim String DB_Callback$
Dim INTEGER DB_File_Ptr(MAX_TBL)
Dim INTEGER DB_Auto_Index = 1
Dim INTEGER DB_Dirty_Flag(MAX_TBL)
Dim STRING Upd_Target_Fld$, Upd_Target_Val$, Upd_Target_Tbl$
Dim STRING Group_Keys$(MAX_GROUPS) length 31
Dim FLOAT Group_Vals(MAX_GROUPS)
Dim INTEGER Group_Counts(MAX_GROUPS)
Dim INTEGER Group_Top, Group_Fld_ID
Dim INTEGER Join_Driver_Tbl, Link_Fld_ID
Dim STRING DB_Link_Fld$, DB_Link_File$

Dim STRING DB_Tbl_Name$(MAX_TBL) LENGTH 31
Dim STRING DB_Tbl_File$(MAX_TBL) LENGTH 31
Dim INTEGER DB_Tbl_Len(MAX_TBL)
Dim INTEGER Table_Count

Dim STRING DB_Fld_Owner$(MAX_FLD) LENGTH 31
Dim STRING DB_Fld_Name$(MAX_FLD) LENGTH 31
Dim INTEGER DB_Fld_Type(MAX_FLD), DB_Fld_Start(MAX_FLD), DB_Fld_Width(MAX_FLD)
Dim INTEGER Field_Count, db_Record_Count

Dim STRING DB_RowBuf$(MAX_TBL)

Type IndexItem
Key As STRING LENGTH 31
RecNo As INTEGER
End Type

Type IndexItemNum
Key As FLOAT
RecNo As INTEGER
End Type

Dim IndexItemNum DB_IndexNum(MAX_RECS)
Dim INTEGER Link_Rec_Count
Dim IndexItem DB_Index(MAX_RECS)
Dim IndexItem DB_Lookup(MAX_RECS)
Dim IndexItemNum DB_LookupNum(MAX_RECS)
Dim IndexItem Result_List(MAX_RECS)

Type joinRecsNum
RecNo1 As INTEGER
RecNo2 As INTEGER
Key As FLOAT
End Type

Type joinRecsAlpha
RecNo1 As INTEGER
RecNo2 As INTEGER
Key As STRING * 31
End Type

Dim joinRecsNum DB_JoinResNum(1)
Dim joinRecsAlpha DB_JoinResAlpha(1)

' =============================================================
' RAILROAD GRAPHICS GLOBALS
' =============================================================
Dim Float Scale
Dim Integer OffX, OffY
Dim Float GridW, GridH
Dim Float ind = 0.6
Dim Float x1_top, x1_bot, x2_top, x2_bot
'Dim Float SegLen(10)
'Dim Integer MacSeg(40), MacRev(40)
'Dim Float MacLen(40), MacOdo(40)
Dim Float TotalMacroLen
Dim Integer mIdx = 0

Dim Integer cTrack = RGB(255, 255, 255)
Dim Integer cSiding = RGB(255, 255, 255)
Dim Integer cSwitch = RGB(255, 255, 0)
Dim Integer cCross = RGB(255, 128, 0)

' --- GLOBAL ACTIVE LAYOUT ---
Dim String Active_Layout$ LENGTH 4 = "1"

' Database Active Roster Arrays (Loaded on RUN)
Const MAX_SWITCHES = 20
Dim Integer SwState(MAX_SWITCHES)
Dim String dCmd$ = ""
Dim Float V(MAX_ENGINES), TV(MAX_ENGINES), D(MAX_ENGINES), oldD(MAX_ENGINES)
Dim String E_Leg$(MAX_ENGINES) length 20, old_E_Leg$(MAX_ENGINES) length 20
Dim Integer wasMoving(MAX_ENGINES)

' Multi-Train Physics Arrays
Dim Integer TR_Count(MAX_ENGINES)
Dim Float TR_PixLen(MAX_ENGINES, MAX_CARS_PER_TRAIN)
Dim Integer TR_IsEng(MAX_ENGINES, MAX_CARS_PER_TRAIN)
Dim Integer TR_Color(MAX_ENGINES, MAX_CARS_PER_TRAIN)
Dim Integer TR_Dir(MAX_ENGINES)
Dim Integer Active_Engine
Dim String TR_ID$(MAX_ENGINES, MAX_CARS_PER_TRAIN) LENGTH 4

E_Leg$(1) = "L3" : old_E_Leg$(1) = "L3"
V(1) = 8.75
Dim String Found_Loc$

Dim Integer PK_Count = 0
Dim String PK_Leg$(MAX_PARKED_CARS) LENGTH 16
Dim Float PK_Dist(MAX_PARKED_CARS), PK_Len(MAX_PARKED_CARS), PK_Offset(MAX_PARKED_CARS)
Dim Integer PK_Color(MAX_PARKED_CARS), PK_IsEng(MAX_PARKED_CARS), PK_Dir(MAX_PARKED_CARS)
Dim String PK_ID$(MAX_PARKED_CARS) LENGTH 4

' --- SPRITE ENGINE GLOBALS ---
Dim Integer Use_Sprites = 0
Dim Integer TR_Sprite(MAX_ENGINES, MAX_CARS_PER_TRAIN)
Dim Integer PK_Sprite(MAX_PARKED_CARS)

' New dynamic cache globals
Dim String Cache_Seg_Name$ LENGTH 16
Dim Integer Cache_Seg_Idx, Cache_Dir
Dim Float Cache_Start_D

Dim Float LegLen(15), Cursor_X, Cursor_Y

Dim Integer Node(MAX_SWITCHES, 2)

' --- DYNAMIC GEOMETRY ARRAYS ---
Dim Integer Layout_Seg_Count, headSeq
Dim String Seg_ID$(MAX_RECS) LENGTH 16
Dim String Seg_Type$(MAX_RECS) LENGTH 2, Seg_CurveType$(MAX_RECS) LENGTH 2
Dim Float Seg_Len(MAX_RECS), Seg_Rad(MAX_RECS)
Dim Float Seg_X1(MAX_RECS), Seg_Y1(MAX_RECS)
Dim Float Seg_X2(MAX_RECS), Seg_Y2(MAX_RECS)
Dim Integer Seg_WestNorth(MAX_RECS) ' 0 if x1,y1 is West/North, 1 if x2,y2

' NEW: Friendly Names
Dim String Seg_Friendly$(MAX_RECS) LENGTH 20
Dim Integer Show_Friendly = 0 ' flag
Dim Integer Show_Names = 0 ' flag
Dim Integer Show_Cars = 0 ' flag
Dim Integer Show_Legend = 1 ' flag

' NEW: Switch and Crossing Storage
Dim Float Switch_X(MAX_SWITCHES), Switch_Y(MAX_SWITCHES)
Dim Float Cross_X, Cross_Y
Dim Integer Has_Cross = 0
Dim Integer Trace_Mode = 0
Dim Integer Force_Redraw = 1 ' flag

Dim String Seg_N1$(MAX_RECS) length 20
Dim String Seg_N2$(MAX_RECS) length 20
Dim String Seg_N3$(MAX_RECS) length 20

' --- DIRTY SEGMENT TRACKING ---
Dim Integer isErase_Global = 0 ' flag
Dim Integer Dirty_Seg(MAX_RECS)

' --- TURNTABLE TRACKING ---
Dim Float RH_CX, RH_CY, RH_Len, RH_BaseAng
Dim Float RH_Orig_X1, RH_Orig_Y1, RH_Orig_X2, RH_Orig_Y2
Dim Float RH_Angle = 0.0
Dim Float RH_Target = 0.0
Dim Integer RH_Idx = 0
Dim Integer Override_Color = -1
Dim Integer rh_moving = 0

' --- SCRIPT ENGINE GLOBALS ---
Dim String Script_Lines$(MAX_SCRIPT_LINES) length 39
Dim Integer Script_Line_Map(MAX_SCRIPT_LINES)
Dim Integer Script_Count = 0
Dim Integer Script_Idx = 0
Dim Float Script_Wait_Time = 0.0
Dim String Script_Wait_Event$ = ""
Dim Integer Is_Recording = 0 ' flag
Dim String Record_File$ = ""

' --- GRAPH CACHE ---
Dim String FastSeg_ID$(5)
Dim Integer FastSeg_Idx(5)
Dim Integer FastSeg_Ptr = 1

Dim Integer Sys_Paused = 0 ' flag

' =============================================================
' MAIN COMMAND LOOP
' =============================================================
If DBG_LVL>2 then Print "Diag0: MAX_RECS: ";MAX_RECS;"; Heap: ";mm.info(heap)
Print "Initializing Database Engine... " + MM.Info(CURRENT)
Option CONSOLE SERIAL ' in program only--not a console option which remais persistant
IF instr(mm.info$(lcdpanel),"MODE") then
mode GLOBAL_MODE ' set video mode for HDMI or VGA
Print mm.device$+" ";mm.info(version);" Video Mode ";GLOBAL_MODE
Else
Is_LCD=1 ' LCD--not HDMI/DVI or VGA
endif
If DBG_LVL>2 then Print "Diag0: MAX_RECS: ";MAX_RECS;"; Heap: ";mm.info(heap)
DummySub

Do
Loop
End

Sub DummySub
End Sub