' Program developed by Jason Page of Page Telegram May of 2024
' V1.00 is not fault tolerant: text file needs consistently 5 columns and
' the last line EOF must not be an empty carriage return.
' This software is not yet ready for release for production, yet until
' Fault tolerant measures are made.
' This software is released privately and folks are welcome to improve
' Upon it. If you have such interest you may contact me:
' jsp@pagetelegram.com
' ToDoGram copyright Jason Page 2024
' This software is developed for easily updatable text based todo display
' and can be implemented in different merchant environments.
' Press "F" to toggle full screen and +/- for incrementing rotation in
' seconds. This software is designed to be compiled in qb64 compiler.
' See qb64.net for details or google for it.
DIM SHARED a$(255), b$(255), c$(255), d$(255), e$(255)
declare sub menu(tis) as dynamic
declare sub disp(tis) as dynamic
_TITLE "ToDoGram V1.00 by Page Telegram, March 2024"
TIMER ON
f = 0
tis = 5
CALL menu(tis)
five:
p = p + 1
CLS
COLOR 15, 2
CLS
LOCATE 1, 1
PRINT " MENU AS OF: "; DATE$; " "; TIME$; " sec:"; tis
COLOR 12, 1
tmp$ = " \ \ \ \ \ \ \ \ \ \ "
PRINT USING tmp$; a$(0); b$(0); c$(0); d$(0); e$(0)
COLOR 15, 0
TIMER STOP
TIMER ON
RETURN
SUB menu (tis)
DO
1:
IF f = 1 THEN
_FULLSCREEN
ELSE
_FULLSCREEN OFF
END IF
p = 1
c = 0: i = 0
CLS
IF _FILEEXISTS("todo.txt") THEN
OPEN "todo.txt" FOR INPUT AS #1
DO
IF NOT (EOF(1)) THEN
INPUT #1, a$(c), b$(c), c$(c), d$(c), e$(c)
c = c + 1
END IF
LOOP UNTIL EOF(1)
CLOSE #1
CALL disp(tis)
COLOR 12, 1
tmp$ = " \ \ \ \ \ \ \ \ \ \ "
PRINT USING tmp$; a$(0); b$(0); c$(0); d$(0); e$(0)
FOR i = 1 TO c
IF i MOD 2 = 1 THEN
COLOR 0, 15
ELSE
COLOR 15, 0
END IF
tmp$ = "## \ \ \ \ \ \ \ \ \ \ "
PRINT USING tmp$; i; a$(i); b$(i); c$(i); d$(i); e$(i)
IF i MOD 17 = 0 THEN
SELECT CASE tis
CASE 1: ON TIMER(1) GOSUB five
CASE 2: ON TIMER(2) GOSUB five
CASE 3: ON TIMER(3) GOSUB five
CASE 4: ON TIMER(4) GOSUB five
CASE 5: ON TIMER(5) GOSUB five
CASE 6: ON TIMER(6) GOSUB five
CASE 7: ON TIMER(7) GOSUB five
CASE 8: ON TIMER(8) GOSUB five
CASE 9: ON TIMER(9) GOSUB five
CASE 10: ON TIMER(10) GOSUB five
CASE 11: ON TIMER(11) GOSUB five
CASE 12: ON TIMER(12) GOSUB five
CASE 13: ON TIMER(13) GOSUB five
CASE 14: ON TIMER(14) GOSUB five
CASE 15: ON TIMER(15) GOSUB five
CASE 16: ON TIMER(16) GOSUB five
CASE 17: ON TIMER(17) GOSUB five
CASE 18: ON TIMER(18) GOSUB five
CASE 19: ON TIMER(19) GOSUB five
CASE 20: ON TIMER(20) GOSUB five
END SELECT
SLEEP
END IF
SELECT CASE LCASE$(INKEY$)
CASE CHR$(27): SYSTEM
CASE "f": IF f = 0 THEN f = 1 ELSE f = 0: GOTO 1
CASE "-", "_":
IF tis > 1 THEN
tis = tis - 1
GOTO 1
ELSE
BEEP
END IF
CASE "+", "=":
IF tis < 20 THEN
tis = tis + 1
GOTO 1
ELSE
BEEP
END IF
END SELECT
NEXT i
ELSE
PRINT "Creating file 'todo.txt' as did not already exist. Please open this file in a text editor such as notepad with 5 columns seperated by a comma."
PRINT "Hit any key..."
SLEEP
OPEN "todo.txt" FOR OUTPUT AS #2
PRINT #2, "Date,Task,N/D,Done,Cost"
PRINT "File created. Please open '~/todo.txt' and add essential display items. Program restarts in 10 seconds."
PRINT "[ESC]ape to exit or toggle full screen mode using [F] key..."
SLEEP 10
CLOSE #2
END IF
SLEEP tis
LOOP
END SUB
SUB disp (tis)
COLOR 15, 2
CLS
LOCATE 1, 1
PRINT " MENU AS OF: "; DATE$; " "; TIME$; " sec:"; tis
COLOR 12, 1
END SUB
Here is a revised version with html view support for local machine and web server.
' Program developed by Jason Page of Page Telegram May of 2024
' V1.00 is not fault tolerant: text file needs consistently 5 columns and
' the last line EOF must not be an empty carriage return.
' This software is not yet ready for release for production, yet until
' Fault tolerant measures are made.
' This software is released privately and folks are welcome to improve
' Upon it. If you have such interest you may contact me:
' jsp@pagetelegram.com
' ToDoGram copyright Jason Page 2024
' This software is developed for easily updatable text based todo display
' and can be implemented in different merchant environments.
' Press "F" to toggle full screen and +/- for incrementing rotation in
' seconds. This software is designed to be compiled in qb64 compiler.
' See qb64.net for details or google for it.
Dim Shared a$(255), b$(255), c$(255), d$(255), e$(255)
declare sub menu(tis) as dynamic
declare sub disp(tis) as dynamic
declare sub web(tis) as dynamic
'DIM localLine$ AS STRING
'DIM columns AS STRING
_Title "ToDoGram V1.01h by Page Telegram, March 2024"
Timer On
f = 0
tis = 5
Call menu(tis)
five:
p = p + 1
Cls
Color 15, 2
Cls
Locate 1, 1
Print " TODO AS OF: "; Date$; " "; Time$; " sec:"; tis
Color 12, 1
tmp$ = " \ \ \ \ \ \ \ \ \ \ "
Print Using tmp$; a$(0); b$(0); c$(0); d$(0); e$(0)
Color 15, 0
Timer Stop
Timer On
Return
Sub web (tis)
Dim columns(5) As String
Open "todo.txt" For Input As #1 ' Open the CSV file for reading
Open "todo.html" For Output As #2 ' Open the HTML file for writing
' Write the beginning of the HTML document
Print #2, "<html><head><title>Todo List</title><meta http-equiv='refresh' content='8'></head><body>"
Print #2, "<table border='1' style='border-collapse: collapse;'>"
' Read the first line for column headings
If Not EOF(1) Then
Line Input #1, headings$
' Initialize variables
Dim heading(5) As String
colNum = 1
temp$ = ""
For i = 1 To Len(headings$)
char$ = Mid$(headings$, i, 1)
If char$ = "," Then
heading(colNum) = temp$
colNum = colNum + 1
temp$ = ""
Else
temp$ = temp$ + char$
End If
Next i
heading(colNum) = temp$ ' Add the last heading after the loop
' Write the header row with custom headings
Print #2, "<tr style='background-color: yellow; color: black;'>"
For i = 1 To colNum
Print #2, "<th>"; heading(i); "</th>"
Next i
Print #2, "</tr>"
End If
' Initialize variables for alternating row colors
rowColor = TRUE
' Read each line from the CSV and write it to the table
Do While Not EOF(1)
Line Input #1, line$
' Manual parsing of line into columns
colNum = 1
temp$ = ""
For i = 1 To Len(line$)
char$ = Mid$(line$, i, 1)
If char$ = "," Then
columns(colNum) = temp$
colNum = colNum + 1
temp$ = ""
Else
temp$ = temp$ + char$
End If
Next i
columns(colNum) = temp$ ' Add the last column after the loop
' Alternate row color between light red and light blue
If rowColor Then
Print #2, "<tr style='background-color: #FFCCCC;'>" ' Light red
rowColor = FALSE
Else
Print #2, "<tr style='background-color: #CCCCFF;'>" ' Light blue
rowColor = TRUE
End If
' Write each column to the table
For i = 1 To colNum
Print #2, "<td>"; columns(i); "</td>"
Next i
Print #2, "</tr>"
Loop
' Write the end of the HTML document
Print #2, "</table></body></html>"
' Close the files
Close #1
Close #2
End Sub
Sub menu (tis)
' ***
'***
' ***
Do
1:
If f = 1 Then
_FullScreen
Else
_FullScreen Off
End If
p = 1
c = 0: i = 0
Cls
If _FileExists("todo.txt") Then
' QBASIC code to remove carriage return at last line of text file if that line contains no text
' Get the filename from user input
afile$ = "todo.txt"
' Open the file
Open afile$ For Input As #1
' Read the file until the last line
While Not EOF(1)
Line Input #1, last_line$
Wend
' Close the file
Close #1
' Check if the last line is empty
If Len(last_line$) = 0 Then
' Re-open the file for writing
Open afile$ For Input As #1
Open afile$ For Output As #2
' Write all lines except the last one
While Not EOF(1)
Line Input #1, last_line$
If Not EOF(1) Then
Print #2, last_line$
End If
Wend
' Close both files
Close #1
Close #2
' PRINT "Removed empty last line from "; afile$
Else
' PRINT "Last line in "; afile$; " is not empty."
End If
Open "todo.txt" For Input As #1
Do
If Not (EOF(1)) Then
Input #1, a$(c), b$(c), c$(c), d$(c), e$(c)
c = c + 1
End If
Loop Until EOF(1)
Close #1
Call disp(tis)
Color 12, 1
tmp$ = " \ \ \ \ \ \ \ \ \ \ "
Print Using tmp$; a$(0); b$(0); c$(0); d$(0); e$(0)
For i = 1 To c
If i Mod 2 = 1 Then
Color 0, 15
Else
Color 15, 0
End If
tmp$ = "## \ \ \ \ \ \ \ \ \ \ "
Print Using tmp$; i; a$(i); b$(i); c$(i); d$(i); e$(i)
If i Mod 20 = 0 Then
Select Case tis
Case 1: On Timer(1) GoSub five
Case 2: On Timer(2) GoSub five
Case 3: On Timer(3) GoSub five
Case 4: On Timer(4) GoSub five
Case 5: On Timer(5) GoSub five
Case 6: On Timer(6) GoSub five
Case 7: On Timer(7) GoSub five
Case 8: On Timer(8) GoSub five
Case 9: On Timer(9) GoSub five
Case 10: On Timer(10) GoSub five
Case 11: On Timer(11) GoSub five
Case 12: On Timer(12) GoSub five
Case 13: On Timer(13) GoSub five
Case 14: On Timer(14) GoSub five
Case 15: On Timer(15) GoSub five
Case 16: On Timer(16) GoSub five
Case 17: On Timer(17) GoSub five
Case 18: On Timer(18) GoSub five
Case 19: On Timer(19) GoSub five
Case 20: On Timer(20) GoSub five
End Select
Sleep
End If
Select Case LCase$(InKey$)
Case Chr$(27): System
Case "f": If f = 0 Then f = 1 Else f = 0: GoTo 1
Case "-", "_":
If tis > 1 Then
tis = tis - 1
GoTo 1
Else
Beep
End If
Case "+", "=":
If tis < 20 Then
tis = tis + 1
GoTo 1
Else
Beep
End If
End Select
Next i
Call web(tis)
Else
Print "Creating file 'todo.txt' as did not already exist. Please open this file in a text editor such as notepad with 5 columns seperated by a comma."
Print "Hit any key..."
Sleep
Open "todo.txt" For Output As #2
Print #2, "Date,Task,N/D,Done,Cost"
Print "File created. Please open '~/todo.txt' and add essential display items. Program restarts in 10 seconds."
Print "[ESC]ape to exit or toggle full screen mode using [F] key..."
Sleep 10
Close #2
End If
Sleep tis
Loop
End Sub
Sub disp (tis)
Color 15, 2
Cls
Locate 1, 1
Print " TODO AS OF: "; Date$; " "; Time$; " sec:"; tis
Color 12, 1
End Sub
Here is the newest version with better error handling:
' Program developed by Jason Page of Page Telegram May of 2024
' This version is more fault-tolerant and streamlined for better performance and reliability.
' FreeBasic -lang qb compatible version
' Constants for UI colors
Const BACKGROUND_COLOR = 15
Const HIGHLIGHT_COLOR = 12
Const NORMAL_TEXT_COLOR = 7
Const ERROR_TEXT_COLOR = 12
Const SUCCESS_TEXT_COLOR = 10
' Global variables
Dim Shared dataArray(255, 5) As String
Dim Shared rotationTime As Integer = 5
Dim Shared fullScreenMode As Boolean = False
Declare Sub InitializeScreen()
Declare Sub LoadData()
Declare Sub DisplayData()
Declare Sub UpdateHTML()
Declare Sub HandleInput()
Declare Sub CheckLastLine()
Declare Sub ToggleFullScreen()
' Main execution starts here
_Title "ToDoGram V1.01h by Page Telegram, March 2024"
Timer On
Call InitializeScreen
Call LoadData
Call DisplayData
Do
Call HandleInput
Sleep rotationTime
Loop Until InKey$ = Chr$(27) ' Loop until ESC is pressed
Sub InitializeScreen
Cls
Color BACKGROUND_COLOR, NORMAL_TEXT_COLOR
Locate 1, 1
Print "TODO AS OF: "; Date$; " "; Time$; " sec:"; rotationTime
End Sub
Sub LoadData
Dim currentLine As Integer
Dim fileLine As String
Dim tempArray() As String
Open "todo.txt" For Input As #1
currentLine = 0
Do Until EOF(1)
Line Input #1, fileLine
tempArray = Split(fileLine, ",")
If UBound(tempArray) >= 4 Then
dataArray(currentLine, 0) = tempArray(0)
dataArray(currentLine, 1) = tempArray(1)
dataArray(currentLine, 2) = tempArray(2)
dataArray(currentLine, 3) = tempArray(3)
dataArray(currentLine, 4) = tempArray(4)
currentLine = currentLine + 1
End If
Loop
Close #1
If currentLine = 0 Then
Print "No data loaded or incorrect file format."
Else
Print "Data loaded successfully."
End If
End Sub
Sub DisplayData
For i As Integer = 0 To 255
If dataArray(i, 0) <> "" Then
Locate 2 + i, 1
Print Using "## \ \ \ \ \ \ \ \ \ \ "; i + 1; dataArray(i, 0); dataArray(i, 1); dataArray(i, 2); dataArray(i, 3); dataArray(i, 4)
End If
Next i
End Sub
Sub HandleInput
Dim key As String
key = InKey$
Select Case key
Case "f", "F"
Call ToggleFullScreen
Case "-", "_"
If rotationTime > 1 Then rotationTime = rotationTime - 1
Case "+", "="
If rotationTime < 20 Then rotationTime = rotationTime + 1
Case Chr$(27) ' ESC key
End
End Select
End Sub
Sub ToggleFullScreen
fullScreenMode = Not fullScreenMode
If fullScreenMode Then
_FullScreen
Else
_FullScreen Off
End If
End Sub
Sub UpdateHTML
Open "todo.html" For Output As #2
Print #2, "<html><head><title>Todo List</title><meta http-equiv='refresh' content='" & Str$(rotationTime) & ";'></head><body>"
Print #2, "<table border='1' style='border-collapse: collapse;'>"
Print #2, "<tr style='background-color: yellow; color: black;'><th>Date</th><th>Task</th><th>N/D</th><th>Done</th><th>Cost</th></tr>"
For i As Integer = 0 To 255
If dataArray(i, 0) <> "" Then
Print #2, "<tr style='background-color: " & IIf(i Mod 2 = 0, "#FFCCCC", "#CCCCFF") & ";'>"
For j As Integer = 0 To 4
Print #2, "<td>"; dataArray(i, j); "</td>"
Next j
Print #2, "</tr>"
End If
Next i
Print #2, "</table></body></html>"
Close #2
End Sub
Sub CheckLastLine
Dim fileContent() As String
Dim totalLines As Integer
Open "todo.txt" For Input As #1
While Not EOF(1)
ReDim Preserve fileContent(totalLines)
Line Input #1, fileContent(totalLines)
totalLines = totalLines + 1
Wend
Close #1
' Check if the last line is empty and remove it if necessary
If totalLines > 0 AndAlso Len(Trim(fileContent(totalLines - 1))) = 0 Then
totalLines = totalLines - 1 ' Reduce the count to ignore the last empty line
Open "todo.txt" For Output As #1
For i As Integer = 0 To totalLines - 1
Print #1, fileContent(i)
Next i
Close #1
Print "Removed empty last line from todo.txt"
Else
Print "No empty last line in todo.txt"
End If
End Sub