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