home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / pb / library4 / pww.bas < prev    next >
Encoding:
BASIC Source File  |  1989-11-27  |  6.4 KB  |  226 lines
  1.  
  2.  
  3.  
  4. '               SCREEN CODER -- HB. Started 7-26-87
  5.  
  6.  DIM LineBuffer$(30): DIM FL(30): DIM FC(30)
  7.  KEY(10) ON
  8.  ON KEY (10) GOSUB QT
  9.  COLOR 14,0
  10.  CLS
  11.  
  12.  
  13. Start:
  14.  LOCATE 25,1: PRINT "[F10] = Quit     [F1] = Help";: LOCATE 1,1
  15.  COLOR 15,2:LOCATE 3,23
  16.  PRINT " THE HB POP-UP WINDOW CODE WRITER "
  17.  COLOR 14,0
  18.  IF COMMAND$ <> "" THEN
  19.     FlNm$ = COMMAND$
  20.  ELSE
  21.     ON ERROR GOTO NoSuchInputFl
  22.     FILES "*.PW"
  23.     ON ERROR GOTO 0
  24.     PRINT  '                                    get a directory ...
  25.  
  26.     COLOR 9,0: INPUT "NAME OF WINDOW DESIGN FILE TO PROCESS:";FlNm$
  27.     IF FlNm$ = "" THEN CLS: STOP
  28.     IF INSTR (FlNm$, ".") THEN FlNm$ = LEFT$(FlNm$,(INSTR(FlNm$,".")-1))
  29.  END IF
  30.  COLOR 10,0: CLS
  31.  COLOR 14,4:LOCATE 3,23
  32.  PRINT "THE HB POP-UP WINDOW CODE WRITER "
  33.  COLOR 10,0
  34.  LOCATE 7,10:PRINT "Will now make window ";FlNm$;" into compliable Basic"
  35.  LOCATE 8,13:PRINT "DATA statements for use with POPWINDOWS calls"
  36.  LOCATE 10,20:PRINT "INPUT FILE IS ";FlNm$+".PW"
  37.  LOCATE 11,20:PRINT "OUTPUT FILE IS ";FlNm$+".INC"
  38.  LOCATE 14,36: PRINT "[F10] = Quit"
  39. '                                                 file names are now set ...
  40. OpenFiles:
  41.  
  42.  ON ERROR GOTO NoSuchInputFl:
  43.  OPEN FlNm$+".PW" FOR INPUT AS 1
  44.  ON ERROR GOTO 0
  45.     COLOR 12,0:PRINT:PRINT " INPUT FILE OPEN -- LENGTH = ";LOF(1)
  46.     COLOR 14,0
  47.  
  48.  OPEN FlNm$+".INC" FOR OUTPUT AS 2
  49.  
  50. '=========================== START PROCESSING INPUT FILE ======================
  51.  
  52. SkipBlanks:
  53.  L = 0
  54.  DO
  55.    INCR L: LINE INPUT #1, In$                ' skip blank lines
  56.    IF EOF(1) THEN PRINT "ERROR 1": STOP
  57.  LOOP UNTIL In$ <> ""
  58.  
  59.  C = 1
  60. '                                                   ' take 1st line ...
  61. SearchBox:
  62.  LOCATE 24,1: COLOR 12,0:PRINT C;In$: COLOR 14,0
  63.  DO WHILE LEFT$(In$,1) = " "                       ' chop spaces off left end
  64.      In$ = MID$(In$,2): GOSUB DispLns: INCR C '             and count them ...
  65.  LOOP
  66.  
  67.  IF LEFT$(In$,1) <> "^" THEN_
  68.    LOCATE 23,1: PRINT ">";In$;"<"
  69.    PRINT "ERROR 2 IN LINE";L;": BOX NOT FOUND":STOP
  70.  
  71. ' ===================== SET WINDOW DIMENSIONS ================================
  72.  
  73.  CornerCol = C: BoxTop = L  '                       top of box has been found
  74.  
  75.  
  76.  Wid = 1: DO UNTIL MID$(In$,Wid,1) <> "^": INCR Wid: LOOP  ' count carrots ...
  77.  DECR Wid,2
  78.  
  79.  O$ = "  DATA "+STR$(Wid)+","+STR$(BoxTop)+","+STR$(CornerCol)
  80.  LineBuffer$(1) = O$
  81.  
  82. ' ============= PARSE EACH LINE DOWN TO BOXBOTTOM =======================
  83.  
  84. ParseLines:
  85.  N = 2
  86.  DO
  87.    INCR L: LINE INPUT #1, In$
  88.    IF EOF(1) THEN PRINT "ERROR -- INPUT FILE INCOMPLETE": STOP
  89.    LOCATE 24,1: COLOR 12,0:PRINT In$: COLOR 14,0
  90.    GOSUB DispLns
  91.  
  92. TrimLine:
  93.    C = 0
  94. '                                          remove blank spaces ...
  95.    DO WHILE LEFT$(In$,1) = " "
  96.      In$ = MID$(In$,2): INCR C
  97.    GOSUB DispLns
  98.    LOOP
  99.  
  100.   IF LEFT$(In$,1) = "^" THEN
  101.      In$ = MID$(In$,2): INCR C '             remove the carrot on the left ...
  102.      GOSUB DispLns
  103.    ELSE
  104.      LOCATE 25,3:PRINT "ERROR 4: LEFT SIDE OF BOX NOT INTACT";: STOP
  105.    END IF
  106.  
  107. Check4Bottom:
  108.    IF LEFT$(In$,1) = "^" THEN
  109.        BoxBottom = L+1  '                               check for bottom
  110.    ELSE
  111.  
  112. Check4Fields:
  113.  
  114.        X = 0 '                 otherwise find the field locations in the line...
  115.        DO
  116.          INCR X: INCR C
  117.          IF MID$(In$,X,1) = "{" THEN '              if a field marker is found
  118.            MID$(In$,X) = " "  '                     replace it w/ a space ...
  119.            INCR Fld%
  120.            FL(Fld%) = L  '                          and plug its location into
  121.            FC(Fld%) = C  '                           arrays for later use ...
  122.          GOSUB DispLns
  123.          END IF
  124.          IF MID$(In$,X,1) = "}" THEN MID$(In$,X) = " "  ' replace } w/ a space ...
  125.        LOOP UNTIL X >= LEN(In$)
  126.  
  127. TrimRightEndOff:
  128.        DO UNTIL RIGHT$(In$,1) <> " " AND RIGHT$(In$,1) <> "^"
  129.          In$ = LEFT$(In$,LEN(In$)-1)
  130.        LOOP
  131.  
  132. Goob:
  133.  
  134.       C = CornerCol + 1 '      Since the carrot has been trimmed off, that's
  135. '                               where the placement of what's left of In$
  136. '                                                 will start on screen ...
  137.       DO UNTIL LEFT$ (In$,1) <> " "
  138.          In$ = MID$(In$,2)
  139.          GOSUB DispLns
  140.          INCR C
  141.       LOOP
  142.  
  143.       IF IN$ <> "" THEN
  144.          LineBuffer$ (N) = "  DATA " + CHR$(34) + In$ + CHR$(34) + ","_
  145.           + STR$(L) + "," + STR$(C)
  146.          INCR N
  147.       END IF
  148.  
  149.    END IF
  150.  
  151.  LOOP UNTIL BoxBottom
  152.  
  153. '         ============== WRITE TO TARGET FILE =================
  154. WriteLns:
  155.  
  156.  PRINT #2, "'   Begin PopWindow data for window {";FlNm$;"}"
  157.  PRINT #2, "'        note: created by PopWindow Writer (PWW) from ";FlNm$;".PW"
  158.  PRINT #2, ""
  159.  LineBuffer$(1) = LineBuffer$(1)+","+STR$(BoxBottom - BoxTop)
  160.  
  161.  '          and write first line of code
  162.  N = 1
  163.  DO UNTIL LineBuffer$(N) = ""
  164.     PRINT #2, LineBuffer$(N)
  165.     LOCATE 24,1: PRINT LineBuffer$(N)
  166.     INCR N
  167.  LOOP
  168.  PRINT #2, "  DATA END"
  169.  PRINT "                               ++++"
  170. '         ===================== READ FIELD DATA =====================
  171. ReadFldData:
  172. PartTwo:
  173.  
  174.  PRINT #2, ""
  175.  PRINT #2, FlNm$+"Fields:" '                           create a line label ...
  176. ' PRINT #2, "'"+SPACE$(50);"fld name, mask str, loc" '         and a remark ...
  177.  
  178.  Fld% = 0
  179.  DO
  180.    LINE INPUT #1,In$
  181.    LOCATE 24,1: COLOR 12,0:PRINT LEFT$ (In$,79): COLOR 14,0
  182.  LOOP UNTIL LEFT$(In$,1) = "\"
  183.  
  184. WritePtII:
  185.  DO
  186.   LINE INPUT #1,In$
  187.   IF In$ <> "" AND LEFT$(In$,1) <> " " THEN
  188.     LOCATE 24,1: COLOR 12,0:PRINT In$: COLOR 14,0
  189.     INCR Fld%
  190.     O$ = "  DATA "+In$+","+STR$(FL(Fld%))+","+STR$(FC(Fld%))
  191.     PRINT #2, O$
  192.   END IF
  193.  LOOP UNTIL EOF(1)
  194.  Report$ = "              DONE, NO ERRORS -- OK"
  195.  IF FL(Fld%) = 0 THEN_
  196.     Report$ = "DONE. INPUT FILE ERROR -- TOO MANY FIELDS NAMED."
  197.  INCR Fld%
  198.  IF FL(Fld%) <> 0 THEN_
  199.   Report$ = "DONE. INPUT FILE ERROR -- TOO MANY FIELD LOCATION"+_
  200.     " MARKERS ({) IN DESIGN."
  201.  PRINT #2, "  DATA END"
  202.  
  203.  Print #2, ""
  204.  PRINT #2, "'  ";DATE$;", ";LEFT$(TIME$,5);_
  205.            ":   end of PopWindow data for window {";FlNm$;"}"
  206.  CLOSE
  207.  PRINT: PRINT "     "; Report$
  208.  STOP
  209.  
  210. '               <<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>
  211.  
  212. QT:
  213.  STOP
  214.  RETURN
  215.  
  216. NoSuchInputFl:
  217.      PRINT:PRINT:PRINT "    ERROR -- Input File ";FlNm$;".PW not found"
  218.      PRINT: STOP
  219.      RESUME
  220.  
  221. DispLns:
  222.  LOCATE 4,1: PRINT SPACE$(80)
  223.  COLOR 10,0: LOCATE 4,1:PRINT In$;: COLOR 14,0
  224.  RETURN
  225.  
  226.