PromptGram

This is a basic teleprompter package that can be connected to a large TV running text off a file for teleprompter for actor/speaker etc; ideal for video production projects. Source code below:

DIM SHARED full$(2048), f$
DIM filz$(255)
DIM O$(4)
DIM fil$
DIM SHARED ps, tf, ap, p, c, i
_TITLE "TelePrompt V1.0 Beta by Page Telegram, Nov. 2020. [ALT+ENTER] for Full Screen."
CLS
c = 0
OA$ = _OS$
O$(0) = "NULL"
O$(1) = "LINUX"
O$(2) = "WINDOWS"
O$(3) = "OSX"
DO
    c = c + 1
    IF INSTR(OA$, O$(c)) THEN b = 1
LOOP UNTIL b = 1 OR c >= 3
PRINT "You are running "; O$(c); c
OA$ = O$(c)
c = 0
IF OA$ = "LINUX" THEN SHELL _HIDE "ls | grep .txt > list.tmp"
IF OA$ = "WINDOWS" THEN SHELL _HIDE "dir/b *.txt > list.tmp"
IF OA$ = "OSX" THEN SHELL _HIDE "ls | grep .txt > list.tmp"
OPEN "list.tmp" FOR INPUT AS #1
IF NOT (EOF(1)) THEN
    a = 0
    DO
        a = a + 1
        INPUT #1, filz$(a)
    LOOP UNTIL (EOF(1))
END IF
CLOSE #1
tf = a
a = 0
SCREEN 13
CLS
ps = 0
LOCATE 1, 1: PRINT "Total files:"; tf
DO
    SELECT CASE UCASE$(INKEY$)
        CASE CHR$(0) + "K" ', CHR$(0) + "H":
            IF ps > 1 THEN
                FOR cr = 1 TO 2048: full$(cr) = "": NEXT cr
                ps = ps - 1
                LOCATE 1, 1
                PRINT "File:"; filz$(ps)
                fil$ = filz$(ps)
                CALL loadf(fil$, ap, p)
                p = 0
                co = 0
            ELSE
                '                BEEP
                COLOR 0, 15
                CLS
                SLEEP 1
                COLOR 7, 0
                CALL loadf(fil$, ap, p)

            END IF
        CASE CHR$(0) + "M" 'p
            IF ps < tf THEN
                FOR cr = 1 TO 2048: full$(cr) = "": NEXT cr
                ps = ps + 1
                LOCATE 1, 1
                PRINT "File "; ps; " of "; tf; ":"; filz$(ps)
                fil$ = filz$(ps)
                CALL loadf(fil$, ap, p)
                p = 0
                co = 0
            ELSE
                '                BEEP
                COLOR 0, 15
                CLS
                SLEEP 1
                COLOR 7, 0
                CALL loadf(fil$, ap, p)

            END IF
        CASE "U", CHR$(0) + "H"
            IF p > 1 THEN
                p = p - 1
                CALL loadf(fil$, ap, p)
            ELSE
                '                BEEP
                COLOR 0, 15
                CLS
                SLEEP 1
                COLOR 7, 0
                CALL loadf(fil$, ap, p)

            END IF
        CASE "D", CHR$(0) + "P"
            IF p < ap THEN
                p = p + 1
                CALL loadf(fil$, ap, p)
            ELSE
                COLOR 0, 15
                CLS
                SLEEP 1
                COLOR 7, 0
                CALL loadf(fil$, ap, p)
            END IF
        CASE CHR$(27): SYSTEM
    END SELECT

LOOP


SUB loadf (fil$, ap, p)
    ap = 0
    OPEN fil$ FOR INPUT AS #2
    DO

        IF NOT (EOF(2)) THEN LINE INPUT #2, f$
        DO

            co = co + 1
            IF co / 38 = INT(co / 38) THEN
                ap = ap + 1
                full$(ap) = MID$(f$, co - 38, co)

            ELSE
                '  IF LEN(f$) - co = co + 38 THEN ap = ap + 1: full$(ap) = MID$(f$, co, LEN(f$))
            END IF
        LOOP UNTIL co >= LEN(f$)
        co = 0

    LOOP UNTIL EOF(2) OR ap > 2040
    CLOSE #2
    CLS
    COLOR 7, 0
    pp = 0
    FOR i = p TO p + 9
        pp = pp + 1
        LOCATE pp + 1, 1
        PRINT LEFT$(full$(i), 38)

    NEXT i
    LOCATE 2, 1
    COLOR 14, 4
    PRINT LEFT$(full$(p), 38)
    COLOR 7, 0
    FOR i = p + 1 TO p + 10

        IF p < ap - 10 THEN
            pp = pp + 1
            LOCATE ABS(i - p) + 10, 1
            PRINT LEFT$(full$(i), 38)
        END IF
    NEXT i
END SUB