home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib40b.dsk / INPUT.ROUTINE.bas < prev    next >
BASIC Source File  |  2023-02-26  |  7KB  |  138 lines
  1. 10  REM ************************
  2. 20  REM * INPUT.ROUTINE        *
  3. 30  REM * BY: GARY KNOX        *  
  4. 40  REM * COPYRIGHT (C) 1991   *
  5. 50  REM * MINDCRAFT PUBL. CORP.*
  6. 60  REM * CONCORD, MA  01742   *
  7. 70  REM ************************
  8. 80  PRINT  CHR$(12) CHR$(21): REM  SHUT OFF 80 COLUMN TEXT SCREEN
  9. 90  HOME : VTAB 9: HTAB 9: PRINT "INPUT ROUTINE DESIGNER": HTAB 13: PRINT "BY: GARY KNOX"
  10. 100  HTAB 5: PRINT "(C) 1991 MINDCRAFT PUBL. CORP.": VTAB 23: HTAB 8: PRINT "PRESS A KEY TO CONTINUE."
  11. 110 X =  PEEK( -16384): IF X >127  THEN  POKE  -16368,0: GOTO 140
  12. 120  GOTO 110
  13. 130  REM *** INSTRUCTION INPUT ROUTINE ***
  14. 140 D$ =  CHR$(4):Q$ =  CHR$(34): DIM S$(20):CL = 0:NA$ = "IN.ROUTINE"
  15. 150  GOTO 480
  16. 160  VTAB 22: HTAB 1: CALL  -868: PRINT "ENTER INSTRUCTION # "N"..PRESS <ESC> WHEN DONE WITH ALL INSTRUCTIONS.":S$(N) = ""
  17. 170  VTAB VT: HTAB BE: PRINT  CHR$(91);: HTAB EN: PRINT  CHR$(93);
  18. 180 U = BE: HTAB U +1: VTAB VT
  19. 190  GET A$
  20. 200  IF  ASC(A$) = 27  THEN 320
  21. 210  IF  ASC(A$) = 21  THEN A$ = " ": GOTO 270
  22. 220  IF  ASC(A$) = 13  THEN 290
  23. 230  IF  ASC(A$) < >8  THEN 270
  24. 240  IF  POS(0) = BE  THEN 190
  25. 250  IF U = BE +1  THEN S$(N) = "": CALL  -1008: PRINT " ";: CALL  -1008: GOTO 180
  26. 260 S$(N) =  LEFT$(S$(N),U -BE -1): CALL  -1008: PRINT " ";:U = U -1: CALL  -1008: GOTO 190
  27. 270  IF U <EN -1  THEN U = U +1:S$(N) = S$(N) +A$: HTAB U: PRINT A$;
  28. 280  GOTO 190
  29. 290  IF N = 15  OR CL < >0  THEN 330
  30. 300  HOME 
  31. 310 N = N +1: VTAB 10: HTAB 1: CALL  -868: GOTO 160
  32. 320 N = N -1
  33. 330  RETURN 
  34. 340  REM 
  35. 350  REM  *** PROGRAM INSTRUCTION ROUTINE ***
  36. 360  HOME 
  37. 370  PRINT : PRINT 
  38. 380  PRINT "   THIS PROGRAM MAKES IT POSSIBLE TO ADDA SUBROUTINE TO YOUR MAIN PROGRAM."
  39. 390  PRINT 
  40. 400  PRINT "   THE SUBROUTINE ALLOWS YOU TO INPUT A CHARACTER STRING OF ANY LENGTH.  YOU CANADD CUSTOM DIRECTIONS FOR THE ROUTINE.  YOU ALSO CAN SPECIFY THE LINE NUMBERS"
  41. 410  PRINT "AND THE INCREMENT BETWEEN LINE NUMBERS."
  42. 420  PRINT 
  43. 430  PRINT "   AFTER THE ROUTINE HAS BEEN CREATED   AND SAVED ON THE DISK, JUST 'EXEC' THE  NEW FILE INTO YOUR OWN PROGRAM."
  44. 440  VTAB 23: HTAB 1: PRINT "PRESS THE <RETURN> KEY.....";: GET A$
  45. 450  RETURN 
  46. 460  REM 
  47. 470  REM  ***MAIN PROGRAM ***
  48. 480  HOME : INVERSE : HTAB 9: PRINT "INPUT ROUTINE DESIGNER": NORMAL : POKE 34,3
  49. 490  VTAB 4: PRINT "INSTRUCTIONS?  Y OR N ";: GET A$: PRINT A$: IF A$ < >"Y"  AND A$ < >"N"  AND A$ < >"y"  AND A$ < >"n"  THEN 490
  50. 500  IF A$ = "Y"  OR A$ = "y"  THEN  GOSUB 360
  51. 510  REM 
  52. 520  REM  *** ENTER ROUTINE INSTRUCTIONS ***
  53. 530 N = 1
  54. 540  HOME : VTAB 2: PRINT "ENTER SCREEN INSTRUCTIONS FOR ROUTINE":VT = 8: VTAB 4:BE = 2:EN = 38: GOSUB 160:NL = N: VTAB 2: HTAB 1: CALL  -868: VTAB 8
  55. 550  REM 
  56. 560  REM  *** DISPLAY INPUT INSTRUCTIONS ***
  57. 570  HOME : VTAB 2: HTAB 13: PRINT "SCREEN LAYOUT"
  58. 580  VTAB 4: HOME 
  59. 590  FOR K = 1 TO NL
  60. 600 HT =  INT((40 - LEN(S$(K)))/2)
  61. 610  HTAB HT: PRINT S$(K)
  62. 620  NEXT K
  63. 630  VTAB 23: HTAB 1: PRINT "<<CORRECT ANY LINES>> Y OR N ";: GET A$: IF A$ < >"Y"  AND A$ < >"N"  AND A$ < >"y"  AND A$ < >"n"  THEN  HTAB 30: CALL  -868: GOTO 630
  64. 640  IF A$ = "N"  OR A$ = "n"  THEN 700
  65. 650  REM 
  66. 660  REM *** CORRECT INSTRUCTIONS ***
  67. 670  IF NL = 1  THEN CL = 1: GOTO 690
  68. 680  VTAB 23: HTAB 11: CALL  -868: PRINT "WHICH LINE? (1-"NL") >>";: INPUT CL: IF CL <1  OR CL >NL  THEN 680
  69. 690 VT = 4 +CL -1: VTAB VT: HTAB 1: CALL  -868:BE = 2:EN = 38:N = CL: GOSUB 160: GOTO 580
  70. 700  HOME : VTAB 8: PRINT "ADD ANY INSTRUCTIONS? Y OR N";: GET A$: IF A$ < >"Y"  AND A$ < >"N"  AND A$ < >"y"  AND A$ < >"n"  THEN 700
  71. 710  IF A$ = "Y"  OR A$ = "y"  THEN N = NL +1: GOTO 540
  72. 720  REM 
  73. 730  REM *** SET ROUTINE LINE NUMBERS ***
  74. 740  POKE 34,1: HOME : VTAB 10: INPUT "FIRST LINE # OF ROUTINE (0-60000)";FL: IF FL <0  OR FL >60000  THEN  HTAB 34: CALL  -868: GOTO 1040
  75. 750  INPUT "LINE # INCREMENTS ";IN
  76. 760  REM 
  77. 770  REM *** SAVE ROUTINE ON DISK ***
  78. 780  HOME : VTAB 10: PRINT "CREATING THE DISK FILE...."
  79. 790  ONERR  GOTO 820
  80. 800  PRINT D$"VERIFY IN.ROUTINE"
  81. 810  GOTO 1230
  82. 820  PRINT D$;"OPEN IN.ROUTINE"
  83. 830  PRINT D$;"WRITE IN.ROUTINE"
  84. 840 LN = FL
  85. 850  PRINT LN"REM ** INPUT ROUTINE **":LN = LN +IN
  86. 860  PRINT LN"REM LOCAL VARIABLES:AZ$,U,BE,EN":LN = LN +IN
  87. 870  PRINT LN"REM **L=MAXIMUM LENGTH OF INPUT STRING **":LN = LN +IN
  88. 880  PRINT LN"REM **L MUST BE DEFINED IN MAIN PROGRAM **":LN = LN +IN
  89. 890  PRINT LN"REM **S$ = INPUT STRING RETURNED TO MAIN PROGRAM **":LN = LN +IN
  90. 900  PRINT LN"VTAB2":LN = LN +IN
  91. 910  FOR K = 1 TO NL
  92. 920 ZQ =  INT((40 - LEN(S$(K)))/2)
  93. 930  PRINT LN"HTAB"ZQ":PRINT"Q$;S$(K);Q$:LN = LN +IN
  94. 940  NEXT K
  95. 945  PRINT LN"IFL>=38THENBE=1:EN=39:GOTO"LN +IN *2:LN = LN +IN
  96. 950  PRINT LN"S$="Q$;Q$":BE=INT((40-L)/2)-1:EN=BE+L+1":LN = LN +IN
  97. 960  PRINT LN"VTAB"NL +4":HTABBE":LN = LN +IN
  98. 970  PRINT LN"PRINTCHR$(91);:HTABEN:PRINTCHR$(93);":LN = LN +IN
  99. 980  PRINT LN"U=BE:VTAB"NL +4":HTABU+1":LN = LN +IN
  100. 990  PRINT LN"GETAZ$":LN = LN +IN
  101. 1000  PRINT LN"IF ASC(AZ$)=21THENAZ$="Q$" "Q$":GOTO"LN +IN *6:LN = LN +IN
  102. 1010  PRINT LN"IFASC(AZ$)=13THEN"LN +IN *7:LN = LN +IN
  103. 1020  PRINT LN"IFASC(AZ$)<>8THEN"LN +IN *4:LN = LN +IN
  104. 1030  PRINT LN"IF POS(0)=BETHEN"LN -IN *4:LN = LN +IN
  105. 1040  PRINT LN"IF U=BE+1 THENS$="Q$;Q$":CALL-1008:PRINT"Q$" "Q$";:CALL  - 1008: GOTO "LN -IN *6:LN = LN +IN
  106. 1050  PRINT LN"S$=LEFT$(S$,U-BE-1):CALL-1008:PRINT"Q$" "Q$";:U = U - 1: CALL  - 1008: GOTO "LN -IN *6:LN = LN +IN
  107. 1060  PRINT LN"IF U<EN-1THENU=U+1:S$=S$+AZ$:HTABU:PRINTAZ$;":LN = LN +IN
  108. 1070  PRINT LN"GOTO"LN -IN *8:LN = LN +IN
  109. 1080  PRINT LN"VTAB24:HTAB12:PRINT"Q$"RETYPE..Y OR N?"Q$";:GETAZ$:IFAZ$<>"Q$"Y"Q$"AND AZ$<>"Q$"N"Q$"AND AZ$<>"Q$"y"Q$"AND AZ$<>"Q$"n"Q$"THEN VTAB24:HTAB1:CALL-868:GOTO"LN:LN = LN +IN
  110. 1090  PRINT LN"IFAZ$="Q$"Y"Q$"OR AZ$="Q$"y"Q$"THEN VTAB"NL +4":HTAB1:CALL-958:S$="Q$;Q$":GOTO"LN -IN *20:LN = LN +IN
  111. 1100  PRINT LN"RETURN"
  112. 1110  PRINT D$;"CLOSE"
  113. 1120  HOME : POKE 34,0: VTAB 5: PRINT "YOUR ROUTINE HAS BEEN SAVED ON THE DISK."
  114. 1130  REM 
  115. 1140  REM *** ROUTINE USE FACTS ***
  116. 1150  HTAB 8: PRINT "THE NAME OF THE FILE IS": PRINT : HTAB 15: PRINT NA$
  117. 1160  VTAB 13: PRINT "TO MERGE THE ROUTINE WITH YOUR PROGRAM"
  118. 1170  PRINT : HTAB 5: PRINT "JUST TYPE THE FOLLOWING COMMAND"
  119. 1180  PRINT : HTAB 8: PRINT "<<< EXEC "NA$" >>>"
  120. 1190  VTAB 20: HTAB 2: PRINT "THE ROUTINE LINE NUMBERS RANGE FROM": PRINT 
  121. 1200 A$ =  STR$(FL) +" TO " + STR$(LN)
  122. 1210  HTAB ((40 - LEN(A$))/2): PRINT A$
  123. 1220  NEW 
  124. 1230  HOME : VTAB 12: PRINT "A FILE 'IN.ROUTINE' ALREADY EXISTS." CHR$(7)
  125. 1240  PRINT : PRINT "DO YOU WANT TO OVERWRITE THIS FILE? Y/N";: GET YN$: PRINT YN$
  126. 1250  IF YN$ < >"Y"  AND YN$ < >"y"  AND YN$ < >"N"  AND YN$ < >"n"  THEN 1230
  127. 1260  IF YN$ = "Y"  OR YN$ = "y"  THEN  PRINT D$"DELETE IN.ROUTINE": GOTO 820
  128. 1270  VTAB 12: CALL  -958: PRINT "ENTER A NAME FOR THE ROUTINE:": PRINT 
  129. 1280  INPUT "";NA$
  130. 1290  IF  LEN(NA$) = 0  THEN  PRINT  CHR$(7): GOTO 1270
  131. 1300  POKE 216,0
  132. 1310  ONERR  GOTO 1340
  133. 1320  PRINT D$"VERIFY "NA$
  134. 1330  VTAB 9: PRINT "A FILE NAMED '"NA$"' ALREADY EXISTS." CHR$(7): GOTO 1270
  135. 1340  IF  PEEK(222) = 16  THEN  HOME : VTAB 9: PRINT "'"NA$"' IS AN IMPROPER": PRINT "PRODOS FILE NAME.";: PRINT  CHR$(7): GOTO 1270
  136. 1350  PRINT D$;"OPEN "NA$
  137. 1360  PRINT D$;"WRITE "NA$
  138. 1370  GOTO 840