Category : Recently Uploaded Files
Archive   : BASIC1A.ZIP
Filename : SWW.BAS
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ ³
' ³ STATIC WINDOW CODER -- HB. Started 7-26-87 / 7-21-89 ³
' ³ ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
DIM LineBuffer$(30): DIM FL(30): DIM FC(30)
Q$ = CHR$(34)
COLOR 14,0
CLS
IF INSTR (UCASE$ (COMMAND$), "BATCH") THEN BatchMode = -1
Start:
COLOR 15,2:LOCATE 3,23
PRINT " THE HB STATIC WINDOW CODE WRITER "
COLOR 14,0
IF COMMAND$ <> "" THEN
FlNm$ = EXTRACT$ (COMMAND$, " ")
ELSE
ON ERROR GOTO NoSuchInputFl
FILES "*.SW"
ON ERROR GOTO 0
PRINT ' get a directory ...
COLOR 9,0: INPUT "NAME OF WINDOW DESIGN FILE TO PROCESS:";FlNm$
IF FlNm$ = "" THEN CLS: GOTO AbnlTermi
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 STATIC WINDOW CODE WRITER "
COLOR 10,0
LOCATE 7,10:PRINT "Will now make window ";FlNm$;" into compliable Basic"
LOCATE 8,13:PRINT "DATA statements.
LOCATE 10,2:PRINT "INPUT FILE IS ";FlNm$+".SW"
LOCATE 11,2:PRINT "OUTPUT FILE IS ";FlNm$+".INC (note: if a file by that"
LOCATE 12,30:PRINT " name exists it will be overwritten.)"
IF NOT BatchMode THEN
LOCATE 14,20,1: PRINT "PROCEED ? (y/n)";
DO: K$ = UCASE$ (INKEY$) : LOOP UNTIL K$ = "Y" OR K$ = "N": PRINT K$
IF K$ <> "Y" THEN PRINT: PRINT "OK, ENDING HERE.": GOTO AbnlTermi
END IF
LOCATE ,,0
' file names are now set ...
OpenFiles:
ON ERROR GOTO NoSuchInputFl:
OPEN FlNm$+".SW" 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, Inpt$ ' skip blank lines
IF EOF(1) THEN BEEP: PRINT "OOPS ... Premature End of File": GOTO AbnlTermi
LOOP UNTIL Inpt$ <> ""
C = 1
' ' take 1st line ...
SearchBox:
LOCATE 24,1: COLOR 12,0:PRINT Inpt$: COLOR 14,0
DO WHILE LEFT$(Inpt$,1) = " " ' chop spaces off left end
Inpt$ = MID$(Inpt$,2): GOSUB DispLns: INCR C ' and count them ...
LOOP
IF LEFT$(Inpt$,1) <> "^" THEN
LOCATE 23,1: PRINT ">";Inpt$: PRINT "OOPS! Checking line";L;
PRINT ": TOP OF BOX NOT FOUND":GOTO AbnlTermi
END IF
' ===================== SET WINDOW DIMENSIONS ================================
CornerCol = C: BoxTop = L ' top of box has been found
Wid = 0
DO UNTIL MID$(Inpt$,Wid+1,1) <> "^": INCR Wid: LOOP ' count carrots ...
PRINT "' Code to write Static Window {";FlNm$;"} to Screen"
PRINT "' note: created by StatWindow Writer (SWW) from ";FlNm$;".SW"
PRINT " COLOR BoxColor MOD 16, BoxColor \ 16"
PRINT " LOCATE "+ STR$(BoxTop)+","+STR$(CornerCol)
T$ = "": FOR N = 1 TO Wid-2: T$ = T$+CHR$(196): NEXT
PRINT " PRINT "+ Q$ + CHR$(218) + T$ + CHR$(191)
PRINT #2, "' Code to write Static Window {";FlNm$;"} to Screen"
PRINT #2, "' note: created by StatWindow Writer (SWW) from ";FlNm$;".SW"
PRINT #2, ""
PRINT #2, " COLOR BoxColor MOD 16, BoxColor \ 16"
PRINT #2, " LOCATE "+ STR$(BoxTop)+","+STR$(CornerCol)
PRINT #2, " PRINT "+ Q$ + CHR$(218) + T$ + CHR$(191) + Q$
' ============= PARSE REMAINING LINES DOWN TO BOXBOTTOM ===============
N = 2
DO
INCR L: LINE INPUT #1, Inpt$
IF EOF(1) THEN PRINT "ERROR -- INPUT FILE INCOMPLETE": GOTO AbnlTermi
LOCATE 24,1: COLOR 12,0:PRINT Inpt$: COLOR 14,0
GOSUB DispLns
' cut off leading spaces ...
DO WHILE LEFT$(Inpt$,1) = " ": Inpt$ = MID$(Inpt$,2) : GOSUB DispLns : LOOP
IF Inpt$ = "" THEN Inpt$ = "^^"
Inpt$ = MID$(Inpt$,2) ' cut off the leading carrot ...
' see if this is the bottom ...
IF LEFT$(Inpt$,1) = "^" THEN
BoxBottom = L+1 ' if there's a second carrot this must be the bottom;
EXIT LOOP
ELSE
' at this point the string
' has to be either spaces
' & text, spaces only, or "".
' ============= Check4Fields =============
C = 0
X = 0 ' otherwise find the field locations in the line...
DO
INCR X: INCR C
IF MID$(Inpt$,X,1) = "{" THEN ' if a field marker is found
MID$(Inpt$,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$(Inpt$,X,1) = "}" THEN MID$(Inpt$,X) = " " ' replace "}" w/ " "
LOOP UNTIL X >= LEN(Inpt$)
' ============ TrimRightEndOff =============
DO UNTIL RIGHT$(Inpt$,1) <> " " AND RIGHT$(Inpt$,1) <> "^"
Inpt$ = LEFT$(Inpt$,LEN(Inpt$)-1)
LOOP
END IF
PRINT #2, " LOCATE "+ STR$(L)+","+STR$(CornerCol)
PRINT #2, " PRINT "+ Q$ + CHR$(179) + Inpt$ _
+ SPACE$ (Wid - LEN (Inpt$) - 2) + CHR$(179) + Q$ + ";"
' LPRINT " It is Written ...";
LOCATE 24,1
PRINT " LOCATE "+ STR$(L)+","+STR$(CornerCol)
PRINT " PRINT "+ Q$ + CHR$(179) + Inpt$ _
+ SPACE$ (Wid - LEN (Inpt$) - 2) + CHR$(179) + Q$ + ";"
LOOP UNTIL BoxBottom
LOCATE 24,1
PRINT " LOCATE "+ STR$(L)+","+STR$(CornerCol)
PRINT " PRINT "+ Q$ + CHR$(192) + T$ + CHR$(217) + Q$ + ";"
PRINT #2, " LOCATE "+ STR$(L)+","+STR$(CornerCol)
PRINT #2, " PRINT "+ Q$ + CHR$(192) + T$ + CHR$(217) + Q$ + ";"
' ===================== READ FIELD DATA =====================
IF Fld% > 0 AND NOT EOF (1) THEN
PRINT #2, ""
PRINT #2, " COLOR FldColor MOD 16, FldColor \ 16"
PRINT #2, FlNm$+"Fields:" ' create a line label ...
PRINT " COLOR FldColor MOD 16, FldColor \ 16"
PRINT FlNm$+"Fields:" ' create a line label ...
Fld% = 0
DO
LINE INPUT #1,Inpt$
LOCATE 24,1: COLOR 12,0:PRINT LEFT$ (Inpt$,79): COLOR 14,0
LOOP UNTIL LEFT$(Inpt$,1) = "\"
WritePtII:
DO UNTIL EOF(1)
LINE INPUT #1,Inpt$
IF Inpt$ <> "" AND LEFT$(Inpt$,1) <> " " THEN
LOCATE 24,1: COLOR 12,0:PRINT Inpt$: COLOR 14,0
INCR Fld%
CommaPos = INSTR (Inpt$, ",")
IF CommaPos = 0 THEN PRINT "NO DELIMITING COMMA IN LINE: ";Inpt$:GOTO AbnlTermi
DO WHILE INSTR (CommaPos+1, Inpt$, ",") > CommaPos
CommaPos = INSTR (CommaPos+1, Inpt$, ",")
LOOP
PRINT " LOCATE " + STR$ (FL(Fld%)) + "," + STR$ (FC(Fld%) + CornerCol)
PRINT " PRINT USING " + MID$ (Inpt$, CommaPos+1) + ";"_
+ LEFT$ (Inpt$, CommaPos-1)
PRINT #2, " LOCATE " + STR$ (FL(Fld%)) + "," + STR$ (FC(Fld%) + CornerCol)
PRINT #2, " PRINT USING " + MID$ (Inpt$, CommaPos+1) + ";"_
+ LEFT$ (Inpt$, CommaPos-1) + ";"
END IF
LOOP
PRINT #2, " COLOR ScrColor MOD 16, ScrColor \ 16"
END IF
Report$ = " DONE, NO ERRORS -- OK"
ECode = 0
IF Fld% > 0 AND FL(Fld%) = 0 THEN
Report$ = "DONE. INPUT FILE ERROR -- TOO MANY FIELDS NAMED."
END IF
INCR Fld%
IF FL(Fld%) <> 0 THEN_
Report$ = "DONE. INPUT FILE ERROR -- TOO MANY FIELD LOCATION"+_
" MARKERS ({) IN DESIGN."
Print #2, ""
PRINT #2, "' ";DATE$;", ";LEFT$(TIME$,5);_
": end of StatWindow generated code for window {";FlNm$;"}"
CLOSE
PRINT: PRINT " "; Report$
IF Report$ <> " DONE, NO ERRORS -- OK" THEN
PLAY "O3 B8 P8 G4"
DO: LOOP UNTIL INKEY$ <> ""
END IF
END
' <<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>
NoSuchInputFl:
PRINT:PRINT:PRINT " ERROR -- Input File ";FlNm$;".SW not found"
PRINT: GOTO AbnlTermi
RESUME
DispLns:
LOCATE 4,1: PRINT SPACE$(80)
COLOR 10,0: LOCATE 4,1:PRINT Inpt$;: COLOR 14,0
RETURN
AbnlTermi:
PLAY "O3 B8 P8 G4"
DO: LOOP UNTIL INKEY$ <> ""
END
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/