| Original Message |
Pete (no login)
Posted Mar 4, 2007 9:16 AM
DECLARE SUB GetKey (r%, C%, l%, w$)
DECLARE FUNCTION GenTime% (f$)
DECLARE SUB FinalPhase ()
DECLARE FUNCTION GenPLine$ (CurStory AS INTEGER)
DECLARE FUNCTION LineSub% (C$)
DECLARE SUB FillHeader ()
DECLARE SUB ShowHeader ()
DECLARE SUB F1 (i%, n$, r%, C%, l%)
DECLARE FUNCTION GetField$ (r%, C%, l%)
DECLARE SUB EstablishRundownID ()
DIM SHARED MyErr AS INTEGER
DIM i AS INTEGER, j AS INTEGER
' ## Initialize Rundown ID
DIM SHARED Status AS STRING * 99
DIM SHARED RunDownID AS STRING, FileId AS STRING
CALL EstablishRundownID
PRINT RunDownID, FileId
' ## Define Rundown Header
TYPE Header
n AS STRING * 16
r AS INTEGER
C AS INTEGER
l AS INTEGER
v AS STRING * 57
END TYPE
DIM SHARED Header(7) AS Header
' ## Define Story Line Format
CONST NumberOfAttributes = 6
DIM SHARED Attribute(NumberOfAttributes) AS STRING
DIM SHARED AttributeStartL(NumberOfAttributes) AS INTEGER
DIM SHARED AttributeLength(NumberOfAttributes) AS INTEGER
DIM StartHere AS INTEGER: StartHere = 5
' ## Process Header
GOSUB InitHeaderConstants
CALL ShowHeader
OPEN FileId FOR INPUT AS #1: LINE INPUT #1, Status
CALL FillHeader
' ## Define Story Database
CONST MaxStories = 99
DIM SHARED Story(MaxStories, NumberOfAttributes) AS STRING
DIM SHARED Time(MaxStories) AS INTEGER
DIM SHARED TotalTime AS INTEGER, OldTime AS INTEGER
' ## Load Saved Stories
DIM SHARED NewStory AS INTEGER
DIM SHARED StoryL(MaxStories) AS STRING
DIM SHARED StoryT(MaxStories) AS INTEGER
IF EOF(1) THEN
CLOSE
OPEN FileId$ FOR OUTPUT AS #1
PRINT #1, Status
FOR i = 1 TO 7: PRINT #1, RTRIM$(Header(i).v): NEXT i
NewStory = 1
ELSE
FOR i = 1 TO MaxStories
IF EOF(1) THEN EXIT FOR
FOR j = 1 TO NumberOfAttributes
IF EOF(1) THEN STOP: 'bad data file
LINE INPUT #1, Story(i, j)
NEXT j
StoryL(i) = GenPLine(i)
NEXT i
NewStory = i
END IF
StoryL(NewStory) = GenPLine(NewStory)
CLOSE
' ## Header Finished
VIEW PRINT 10 TO 25
CONST Line1 = 10, LineMax = 20
' ## Input Stories
DO
k% = LineSub("Show")
DO
p$ = "I = Input stories F = Finished entering stories E = Edit I/F/E: "
LOCATE 22, 1: PRINT p$;
DO
k$ = UCASE$(INKEY$)
IF k$ <> "" THEN EXIT DO
LOOP
k$ = k$ + "x"
LOCATE 22, 1: PRINT SPACE$(79);
IF k$ = CHR$(27) + "x" THEN VIEW PRINT: CLS : SYSTEM
LOOP WHILE INSTR("FxIxEx", k$) = 0
IF k$ = "Fx" THEN EXIT DO
IF k$ = "Ex" THEN
SHELL "Notepad " + FileId
OPEN "Fxx.sv2" FOR OUTPUT AS #1: PRINT #1, RunDownID: CLOSE
RUN
END IF
LOCATE 22, 1: PRINT "Press ESC when finished."
DO
k% = LineSub("Show")
LOOP WHILE LineSub("Get")
LOOP
' ## All data in place
ON TIMER(1) GOSUB Clock: GOSUB Clock: TIMER ON
CALL FinalPhase
VIEW PRINT: CLS
SYSTEM
Clock:
r7% = CSRLIN: c7% = POS(0): VIEW PRINT
LOCATE 1, 73: PRINT TIME$;
IF TotalTime <> LastTime THEN
outt% = TotalTime \ 60
outt$ = RIGHT$(STR$(100 + outt%), 2) + ":"
outt% = TotalTime - (outt% * 60)
outt$ = outt$ + RIGHT$(STR$(100 + outt%), 2)
LOCATE 6, 64: PRINT outt$;
LastTime = TotalTime
END IF
VIEW PRINT 10 TO 25: LOCATE r7%, c7%, 1
RETURN
GetMyErr: MyErr = ERR: RESUME NEXT
InitHeaderConstants:
CALL F1(1, "SCHEDULED TALENT", 3, 3, 41)
CALL F1(4, "FLOOR", 3, 63, 8)
CALL F1(2, "PRODUCER", 4, 3, 17)
CALL F1(3, "DIRECTOR", 4, 32, 19)
CALL F1(7, "TELE.", 4, 63, 8)
CALL F1(5, "TECHNICAL", 5, 3, 16)
CALL F1(6, "AUDIO", 5, 32, 22)
Attribute(1) = " STORY "
Attribute(2) = " SOURCE "
Attribute(3) = " TALENT "
Attribute(4) = "CAMERA"
Attribute(5) = " TIME "
Attribute(6) = "NTS"
FOR i = 1 TO NumberOfAttributes
l% = LEN(Attribute(i))
AttributeStartL(i) = StartHere
AttributeLength(i) = l%
StartHere = StartHere + l% + 3
NEXT i
RETURN
SUB EstablishRundownID
MyErr = 0: ON ERROR GOTO GetMyErr
OPEN "Fxx.sv2" FOR INPUT AS #1: LINE INPUT #1, RunDownID: CLOSE
KILL "Fxx.sv2"
IF MyErr > 0 THEN
CLS : LOCATE 10, 10: PRINT "Enter a two-digit identity for this rundown"
LOCATE , 13: PRINT "(Or just press Enter to terminate run)"
PRINT : PRINT
DO
PRINT : LINE INPUT "ID (00-99): "; id$
IF id$ = "" THEN SYSTEM
IF LEN(id$) = 2 THEN
IF INSTR("0123456789", LEFT$(id$, 1)) > 0 THEN
IF INSTR("0123456789", RIGHT$(id$, 1)) > 0 THEN RunDownID = id$
END IF
END IF
LOOP WHILE RunDownID$ = ""
END IF
FileId = "F" + RunDownID + ".sv2"
MyErr = 0: ON ERROR GOTO GetMyErr
OPEN FileId FOR INPUT AS #1
IF MyErr > 0 THEN
ON ERROR GOTO 0
DO
PRINT "You want to create a NEW rundown. Correct? y/n: ";
a$ = INPUT$(1): PRINT a$: a$ = UCASE$(a$)
IF a$ = "N" THEN RUN
LOOP WHILE a$ <> "Y"
MyErr = 0: ON ERROR GOTO GetMyErr
OPEN FileId FOR OUTPUT AS #1: PRINT #1, Status: CLOSE
ON ERROR GOTO 0
IF MyErr > 0 THEN PRINT "?? Unable to create "; FileId: SYSTEM
ELSE
LINE INPUT #1, l$
ON ERROR GOTO 0
IF LEN(l$) <> LEN(Status) THEN
PRINT "?? Bad format: "; FileId: SYSTEM
END IF
END IF
CLOSE
END SUB
SUB F1 (i%, n$, r%, C%, l%)
Header(i%).n = n$
Header(i%).r = r%
Header(i%).C = C%
Header(i%).l = l%
END SUB
SUB FillHeader
DIM i AS INTEGER
FOR i = 1 TO 7
v$ = SPACE$(Header(i).l)
r% = Header(i).r
C% = Header(i).C + LEN(RTRIM$(Header(i).n)) + 2
IF EOF(1) THEN
k$ = GetField(r%, C%, Header(i).l)
IF k$ = CHR$(27) THEN EXIT FOR
LSET v$ = k$
ELSE
LINE INPUT #1, l$: LSET v$ = l$
END IF
LOCATE r%, C%
COLOR 15, 0: PRINT v$: COLOR 7, 0
LSET Header(i).v = v$
NEXT i
IF i < 8 THEN
COLOR 7, 0: CLS
PRINT "Rundown"; RunDownID; " was not created."
CLOSE
KILL FileId
SYSTEM
END IF
END SUB
SUB FinalPhase
IF NewStory < 2 THEN EXIT SUB
DIM i AS INTEGER, DoCurX AS INTEGER
FOR i = 1 TO 99
SELECT CASE MID$(Status, i, 1)
CASE "1", "2", " ":
CASE ELSE: STOP: MID$(Status, i, 1) = " ": 'just remove that debug stop
END SELECT
NEXT i
DIM s AS STRING: s = Status
DIM LastStory AS INTEGER: LastStory = NewStory - 1
FOR i = 1 TO LastStory: StoryT(i) = GenTime(Story(i, 5)): NEXT i
DIM StoryTop AS INTEGER, StoryBot AS INTEGER
IF LastStory + Line1 <= LineMax THEN
StoryTop = 1
ELSE
StoryTop = LastStory - LineMax + Line1 + 1
END IF
StoryBot = LastStory
DIM StoryCur AS INTEGER: StoryCur = LastStory
DIM LineCur AS INTEGER: LineCur = Line1 + StoryBot - StoryTop
GOSUB Refresh
DO
DO: k$ = INKEY$: LOOP WHILE k$ = ""
SELECT CASE k$
CASE CHR$(27): EXIT DO
CASE CHR$(0) + "H", "8":
IF LineCur > Line1 THEN
DoCurX = 0: GOSUB DoCur
LineCur = LineCur - 1: StoryCur = StoryCur - 1
DoCurX = 1: GOSUB DoCur
ELSE
IF StoryTop > 1 THEN
StoryCur = StoryCur - 1
StoryTop = StoryTop - 1
StoryBot = StoryBot - 1
GOSUB Refresh
END IF
END IF
CASE CHR$(0) + "P", "2":
IF (LineCur < LineMax - 1) AND (StoryCur < StoryBot) THEN
DoCurX = 0: GOSUB DoCur
LineCur = LineCur + 1: StoryCur = StoryCur + 1
DoCurX = 1: GOSUB DoCur
ELSE
IF StoryBot < LastStory THEN
StoryCur = StoryCur + 1
StoryTop = StoryTop + 1
StoryBot = StoryBot + 1
GOSUB Refresh
END IF
END IF
CASE " ":
SELECT CASE MID$(s, StoryCur, 1)
CASE " ": MID$(s, StoryCur, 1) = "1"
CASE "1": MID$(s, StoryCur, 1) = "2"
CASE "2": MID$(s, StoryCur, 1) = " "
END SELECT
GOSUB Refresh
END SELECT
LOOP
IF s = Status THEN EXIT SUB
OPEN FileId FOR BINARY AS #1
FOR i = 1 TO 99
IF MID$(s, i, 1) <> MID$(Status, i, 1) THEN
v$ = MID$(s, i, 1): PUT #1, i, v$
END IF
NEXT i
CLOSE
EXIT SUB
Refresh:
CLS
TotalTime = 0
FOR i = 1 TO LastStory
IF MID$(s, i, 1) <> "2" THEN TotalTime = TotalTime + StoryT(i)
NEXT i
FOR i = StoryTop TO StoryBot
LOCATE Line1 + i - StoryTop, 1
p$ = StoryL(i)
SELECT CASE MID$(s, i, 1)
CASE " ": PRINT p$;
CASE "1": COLOR 0, 7: PRINT p$; : COLOR 7, 0
CASE "2": COLOR 4, 3: PRINT p$; : COLOR 7, 0
END SELECT
NEXT i
LOCATE 22, 1: PRINT "Arrow keys to select, spacebar to toggle, ESC to exit";
DoCurX = 1: GOSUB DoCur
RETURN
DoCur:
LOCATE LineCur, 3
IF DoCurX = 0 THEN PRINT "."; ELSE PRINT ">";
RETURN
END SUB
FUNCTION GenPLine$ (CurStory AS INTEGER)
DIM i AS INTEGER
w$ = STR$(CurStory) + ". "
w$ = RIGHT$(w$, 4)
FOR i = 1 TO NumberOfAttributes - 1
w2$ = SPACE$(AttributeLength(i)): LSET w2$ = Story(CurStory, i)
w$ = w$ + w2$ + " | "
NEXT i
w2$ = SPACE$(AttributeLength(NumberOfAttributes))
LSET w2$ = Story(CurStory, NumberOfAttributes)
GenPLine$ = w$ + w2$
END FUNCTION
FUNCTION GenTime% (f$)
DIM y AS INTEGER: y = INSTR(f$, ":"): IF y < 3 THEN EXIT FUNCTION
IF LEN(f$) < y + 2 THEN EXIT FUNCTION
t% = VAL(MID$(f$, y - 2, 2)) * 60
GenTime% = t% + VAL(MID$(f$, y + 1, 2))
END FUNCTION
FUNCTION GetField$ (r%, C%, l%)
DIM fdat AS STRING
DO
LOCATE r%, C%, 1: COLOR 1, 7: PRINT SPACE$(l%)
LOCATE r%, C%
CALL GetKey(r%, C%, l%, w$): fdat = w$
LOCATE r%, C%: COLOR 7, 0: PRINT SPACE$(l%)
IF MID$(fdat, 1, 1) <> CHR$(27) THEN
LOCATE r%, C%: PRINT fdat: EXIT DO
ELSE
IF fdat = CHR$(27) THEN LOCATE 22, 1: PRINT SPACE$(80); : SYSTEM
END IF
w$ = ""
LOOP
GetField$ = fdat
END FUNCTION
SUB GetKey (r%, C%, l%, w$)
numofspaces% = l%
startpos% = POS(1)
endpos% = startpos% + numofspaces%
DO
DO
b$ = INKEY$
IF b$ <> "" THEN EXIT DO
LOOP
xx% = CSRLIN: yy% = POS(1)
SELECT CASE b$
CASE CHR$(0) + "K"
mov% = -1: GOSUB action
CASE CHR$(0) + "M"
mov% = 1: GOSUB action
CASE CHR$(0) + "S"
GOSUB wash: GOSUB delete
CASE CHR$(0) + "R"
IF ins% = 0 THEN ins% = -1 ELSE ins% = 0
IF ins% = 0 THEN LOCATE , , 1, 7, 7 ELSE LOCATE , , 1, 7, 30
CASE CHR$(0) + "O"
IF w$ <> "" THEN LOCATE xx%, startpos% + LEN(w$)
CASE CHR$(0) + "G"
LOCATE xx%, startpos%
CASE CHR$(8)
IF yy% > startpos% THEN
LOCATE , POS(1) - 1
yy% = POS(1)
GOSUB wash: GOSUB delete
END IF
CASE CHR$(13)
EXIT SUB
REM Enter your routine here.
CASE CHR$(27)
w$ = CHR$(27) + w$
EXIT SUB
CASE CHR$(32) TO CHR$(126)
key$ = b$: GOSUB action
END SELECT
mov% = 0: key$ = ""
LOOP
action:
IF POS(1) + mov% >= startpos% AND POS(1) + mov% < endpos% THEN
DO
IF key$ <> "" THEN
SELECT CASE ins%
CASE 0
IF LEN(w$) + LEN(key$) > endpos% - startpos% THEN EXIT DO
w$ = MID$(w$, 1, POS(1) - startpos%) + key$ + MID$(w$, POS(1) - startpos% + 1)
CASE -1
w$ = MID$(w$, 1, POS(1) - startpos%) + key$ + MID$(w$, POS(1) - startpos% + 2)
END SELECT
END IF
IF POS(1) - startpos% >= LEN(w$) - LEN(key$) OR key$ = "" OR ins% = -1 THEN
LOCATE , POS(1) + mov%: PRINT key$;
ELSE
LOCATE xx%, startpos%: PRINT MID$(w$, 1, yy% - startpos%); key$; : yy2% = POS(1): PRINT MID$(w$, yy% - startpos% + 2); : LOCATE xx%, yy2%
END IF
EXIT DO
LOOP
END IF
RETURN
wash:
IF POS(1) >= startpos% AND w$ <> "" THEN
LOCATE xx%, startpos% + LEN(w$) - 1
PRINT " ";
LOCATE xx%, yy%
END IF
RETURN
delete:
IF POS(1) - startpos% = 0 THEN
w$ = MID$(w$, 2)
ELSE
w$ = MID$(w$, 1, POS(1) - startpos%) + MID$(w$, POS(1) - startpos% + 2)
END IF
PRINT MID$(w$, yy% - startpos% + 1); : LOCATE xx%, yy%
RETURN
END SUB
FUNCTION LineSub% (C$)
STATIC LineCur AS INTEGER
DIM i AS INTEGER, CurStory AS INTEGER
SELECT CASE C$
CASE "Show":
SELECT CASE NewStory
CASE 0: STOP' Bug. Too many stories
CASE IS <= LineMax - Line1:
LOCATE Line1, 1
FOR CurStory = 1 TO NewStory - 1: PRINT GenPLine$(CurStory): NEXT CurStory
LineCur = Line1 + CurStory - 1
CASE ELSE:
LOCATE Line1, 1
FOR CurStory = NewStory - LineMax + Line1 TO NewStory - 1
PRINT GenPLine$(CurStory)
NEXT CurStory
LineCur = LineMax
END SELECT
CASE "Get":
CurStory = NewStory: w$ = GenPLine$(CurStory): Blank$ = w$
LOCATE LineCur, 1: PRINT Blank$
FOR i = 1 TO NumberOfAttributes
x$ = GetField(LineCur, AttributeStartL(i), AttributeLength(i))
IF x$ = CHR$(27) THEN
Story(NewStory, 1) = ""
LOCATE LineCur, 1: PRINT Blank$
EXIT FUNCTION
END IF
Story(NewStory, i) = x$
MID$(w$, AttributeStartL(i), LEN(x$)) = x$
NEXT i
StoryL(NewStory) = w$
OPEN FileId$ FOR APPEND AS #1
FOR i = 1 TO NumberOfAttributes
PRINT #1, Story(NewStory, i)
NEXT i
CLOSE
NewStory = NewStory + 1
LineSub% = -1
END SELECT
END FUNCTION
SUB ShowHeader
CLS
PRINT LEFT$(DATE$, 5);
LOCATE , 30: PRINT "R-U-N-D-O-W-N #"; RunDownID;
DIM i AS INTEGER
FOR i = 1 TO 7
LOCATE Header(i).r, Header(i%).C
PRINT RTRIM$(Header(i).n); ": ";
h$ = Header(i%).v
IF ASC(h$) > 0 THEN COLOR 15, 0: PRINT RTRIM$(h$); : COLOR 7, 0
NEXT i
l$ = SPACE$(4)
FOR i = 1 TO 6
l% = AttributeLength(i): l$ = l$ + STRING$(l%, "-")
IF i < 6 THEN l$ = l$ + " | "
NEXT i
LOCATE 7, 1: PRINT l$
PRINT " ";
FOR i = 1 TO 6
l% = AttributeLength(i): PRINT Attribute(i);
IF i = 6 THEN PRINT "" ELSE PRINT " | ";
NEXT i
PRINT l$
END SUB
|
|
|