home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
basic
/
library
/
pb
/
library4
/
pww.bas
< prev
next >
Wrap
BASIC Source File
|
1989-11-26
|
7KB
|
226 lines
' SCREEN CODER -- HB. Started 7-26-87
DIM LineBuffer$(30): DIM FL(30): DIM FC(30)
KEY(10) ON
ON KEY (10) GOSUB QT
COLOR 14,0
CLS
Start:
LOCATE 25,1: PRINT "[F10] = Quit [F1] = Help";: LOCATE 1,1
COLOR 15,2:LOCATE 3,23
PRINT " THE HB POP-UP WINDOW CODE WRITER "
COLOR 14,0
IF COMMAND$ <> "" THEN
FlNm$ = COMMAND$
ELSE
ON ERROR GOTO NoSuchInputFl
FILES "*.PW"
ON ERROR GOTO 0
PRINT ' get a directory ...
COLOR 9,0: INPUT "NAME OF WINDOW DESIGN FILE TO PROCESS:";FlNm$
IF FlNm$ = "" THEN CLS: STOP
IF INSTR (FlNm$, ".") THEN FlNm$ = LEFT$(FlNm$,(INSTR(FlNm$,".")-1))
END IF
COLOR 10,0: CLS
COLOR 14,4:LOCATE 3,23
PRINT "THE HB POP-UP WINDOW CODE WRITER "
COLOR 10,0
LOCATE 7,10:PRINT "Will now make window ";FlNm$;" into compliable Basic"
LOCATE 8,13:PRINT "DATA statements for use with POPWINDOWS calls"
LOCATE 10,20:PRINT "INPUT FILE IS ";FlNm$+".PW"
LOCATE 11,20:PRINT "OUTPUT FILE IS ";FlNm$+".INC"
LOCATE 14,36: PRINT "[F10] = Quit"
' file names are now set ...
OpenFiles:
ON ERROR GOTO NoSuchInputFl:
OPEN FlNm$+".PW" FOR INPUT AS 1
ON ERROR GOTO 0
COLOR 12,0:PRINT:PRINT " INPUT FILE OPEN -- LENGTH = ";LOF(1)
COLOR 14,0
OPEN FlNm$+".INC" FOR OUTPUT AS 2
'=========================== START PROCESSING INPUT FILE ======================
SkipBlanks:
L = 0
DO
INCR L: LINE INPUT #1, In$ ' skip blank lines
IF EOF(1) THEN PRINT "ERROR 1": STOP
LOOP UNTIL In$ <> ""
C = 1
' ' take 1st line ...
SearchBox:
LOCATE 24,1: COLOR 12,0:PRINT C;In$: COLOR 14,0
DO WHILE LEFT$(In$,1) = " " ' chop spaces off left end
In$ = MID$(In$,2): GOSUB DispLns: INCR C ' and count them ...
LOOP
IF LEFT$(In$,1) <> "^" THEN_
LOCATE 23,1: PRINT ">";In$;"<"
PRINT "ERROR 2 IN LINE";L;": BOX NOT FOUND":STOP
' ===================== SET WINDOW DIMENSIONS ================================
CornerCol = C: BoxTop = L ' top of box has been found
Wid = 1: DO UNTIL MID$(In$,Wid,1) <> "^": INCR Wid: LOOP ' count carrots ...
DECR Wid,2
O$ = " DATA "+STR$(Wid)+","+STR$(BoxTop)+","+STR$(CornerCol)
LineBuffer$(1) = O$
' ============= PARSE EACH LINE DOWN TO BOXBOTTOM =======================
ParseLines:
N = 2
DO
INCR L: LINE INPUT #1, In$
IF EOF(1) THEN PRINT "ERROR -- INPUT FILE INCOMPLETE": STOP
LOCATE 24,1: COLOR 12,0:PRINT In$: COLOR 14,0
GOSUB DispLns
TrimLine:
C = 0
' remove blank spaces ...
DO WHILE LEFT$(In$,1) = " "
In$ = MID$(In$,2): INCR C
GOSUB DispLns
LOOP
IF LEFT$(In$,1) = "^" THEN
In$ = MID$(In$,2): INCR C ' remove the carrot on the left ...
GOSUB DispLns
ELSE
LOCATE 25,3:PRINT "ERROR 4: LEFT SIDE OF BOX NOT INTACT";: STOP
END IF
Check4Bottom:
IF LEFT$(In$,1) = "^" THEN
BoxBottom = L+1 ' check for bottom
ELSE
Check4Fields:
X = 0 ' otherwise find the field locations in the line...
DO
INCR X: INCR C
IF MID$(In$,X,1) = "{" THEN ' if a field marker is found
MID$(In$,X) = " " ' replace it w/ a space ...
INCR Fld%
FL(Fld%) = L ' and plug its location into
FC(Fld%) = C ' arrays for later use ...
GOSUB DispLns
END IF
IF MID$(In$,X,1) = "}" THEN MID$(In$,X) = " " ' replace } w/ a space ...
LOOP UNTIL X >= LEN(In$)
TrimRightEndOff:
DO UNTIL RIGHT$(In$,1) <> " " AND RIGHT$(In$,1) <> "^"
In$ = LEFT$(In$,LEN(In$)-1)
LOOP
Goob:
C = CornerCol + 1 ' Since the carrot has been trimmed off, that's
' where the placement of what's left of In$
' will start on screen ...
DO UNTIL LEFT$ (In$,1) <> " "
In$ = MID$(In$,2)
GOSUB DispLns
INCR C
LOOP
IF IN$ <> "" THEN
LineBuffer$ (N) = " DATA " + CHR$(34) + In$ + CHR$(34) + ","_
+ STR$(L) + "," + STR$(C)
INCR N
END IF
END IF
LOOP UNTIL BoxBottom
' ============== WRITE TO TARGET FILE =================
WriteLns:
PRINT #2, "' Begin PopWindow data for window {";FlNm$;"}"
PRINT #2, "' note: created by PopWindow Writer (PWW) from ";FlNm$;".PW"
PRINT #2, ""
LineBuffer$(1) = LineBuffer$(1)+","+STR$(BoxBottom - BoxTop)
' and write first line of code
N = 1
DO UNTIL LineBuffer$(N) = ""
PRINT #2, LineBuffer$(N)
LOCATE 24,1: PRINT LineBuffer$(N)
INCR N
LOOP
PRINT #2, " DATA END"
PRINT " ++++"
' ===================== READ FIELD DATA =====================
ReadFldData:
PartTwo:
PRINT #2, ""
PRINT #2, FlNm$+"Fields:" ' create a line label ...
' PRINT #2, "'"+SPACE$(50);"fld name, mask str, loc" ' and a remark ...
Fld% = 0
DO
LINE INPUT #1,In$
LOCATE 24,1: COLOR 12,0:PRINT LEFT$ (In$,79): COLOR 14,0
LOOP UNTIL LEFT$(In$,1) = "\"
WritePtII:
DO
LINE INPUT #1,In$
IF In$ <> "" AND LEFT$(In$,1) <> " " THEN
LOCATE 24,1: COLOR 12,0:PRINT In$: COLOR 14,0
INCR Fld%
O$ = " DATA "+In$+","+STR$(FL(Fld%))+","+STR$(FC(Fld%))
PRINT #2, O$
END IF
LOOP UNTIL EOF(1)
Report$ = " DONE, NO ERRORS -- OK"
IF FL(Fld%) = 0 THEN_
Report$ = "DONE. INPUT FILE ERROR -- TOO MANY FIELDS NAMED."
INCR Fld%
IF FL(Fld%) <> 0 THEN_
Report$ = "DONE. INPUT FILE ERROR -- TOO MANY FIELD LOCATION"+_
" MARKERS ({) IN DESIGN."
PRINT #2, " DATA END"
Print #2, ""
PRINT #2, "' ";DATE$;", ";LEFT$(TIME$,5);_
": end of PopWindow data for window {";FlNm$;"}"
CLOSE
PRINT: PRINT " "; Report$
STOP
' <<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>
QT:
STOP
RETURN
NoSuchInputFl:
PRINT:PRINT:PRINT " ERROR -- Input File ";FlNm$;".PW not found"
PRINT: STOP
RESUME
DispLns:
LOCATE 4,1: PRINT SPACE$(80)
COLOR 10,0: LOCATE 4,1:PRINT In$;: COLOR 14,0
RETURN