home *** CD-ROM | disk | FTP | other *** search
/ Between Heaven & Hell 2 / BetweenHeavenHell.cdr / 100 / 73 / pcinput.bas < prev    next >
BASIC Source File  |  1984-05-29  |  6KB  |  57 lines
  1. 1 REM ==>  LINES 10 & 11 MUST BE ONE OF FIRST LINES EXECUTED
  2. 10 II%=80:DIM IA$(30):IA$(1)="0123456789.- ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%&*()+=:;{}[]<>,/?'":IA$(2)="0123456789.-":IA$(3)="YN":I0$=STRING$(II%,255):I6$="  ":I7$="    ":I8$="        "
  3. 11 DEF FNIE$=LEFT$(I0$,IQ%):DEF FNIG%=IA%-1<1:DEF FNIP%(A%,B%)=(I9%=>A% AND I9%<=B%):DEF FNIU%=I9%=27:DIM IB#(30,2),IC$(30),IM$(30),IO$(30),ID$(80),I%(10),I6%(10):I6%(7)=8  '  ASCII CODE FOR CURSOR CHARACTER
  4. 10998 REM PCINPUT (IBM PC VERSION 1.8) COPYRIGHT 1983 BY CARL R. STATON
  5. 10999 REM (419) 347-3209          17 FRANKLIN AVENUE   SHELBY  OH  44875
  6. 11000 ON ERROR GOTO 11008:IF LEN(ID$)<1 AND I%>0 AND I%<II% AND INSTR(I1$,"O")<1 THEN ID$=ID$(I%)
  7. 11001 I1%=VAL(LEFT$(I1$,2)):I2%=VAL(MID$(I1$,3,2)):I3%=VAL(MID$(I1$,5,2)):I5%=VAL(MID$(I1$,7,2))
  8. 11002 I4%=((INSTR(I1$,"A")>0)*-1) + ((INSTR(I1$,"N")>0)*-2) + ((INSTR(I1$,"S")>0)*-4) + ((INSTR(I1$,"K")>0)*-8) + ((INSTR(I1$,"F")>0)*-32) + ((INSTR(I1$,"M")>0)*-64) + ((INSTR(I1$,"D")>0)*-128) + ((INSTR(I1$,"O")>0)*-16)
  9. 11003 I4%=I4% + ((INSTR(I1$,"P")>0)*-256) + ((INSTR(I1$,"E")>0)*-512):I6%(5)=I6%(1):I6%(6)=I6%(2):I6%(1)=0:I6%(2)=0:I6%(3)=0:I6%(4)=0:I6%(2)=((INSTR(I1$,"R")>0)*-7)
  10. 11004 I6%(3)=(-1*(INSTR(I1$,"H")>0)) + (-1*(INSTR(I1$,"R")>0)) + (-1*(INSTR(I1$,"I")>0))
  11. 11005 I6%(4)=(-1*(INSTR(I1$,"U")>0)) + (-1*(INSTR(I1$,"b")>0)) + (-2*(INSTR(I1$,"g")>0)) + (-4*(INSTR(I1$,"r")>0)) + (-7*(INSTR(I1$,"w")>0))
  12. 11006 IF ((-1*(I4% AND 1)) + (-1*(I4% AND 2)) + (-1*(I4% AND 4)) + (-1*(I4% AND 8)) + (-1*(I4% AND 16)) + (-1*(I4% AND 32))) > 1 OR (I6%(3)<>0 AND I6%(3)<>1) OR INSTR(CHR$(0)+CHR$(1)+CHR$(2)+CHR$(4)+CHR$(7)+CHR$(8),CHR$(I6%(4)))=0 THEN 11008
  13. 11007 IF I1%>0 AND I1%<26 AND I2%>0 AND I2%<II%+1 AND I3%>0 AND I3%<II%+1 AND I5%>0 AND I5%<31 THEN IF I4% AND 32 THEN I3%=LEN(IM$(I5%)):GOTO 11009 ELSE 11009
  14. 11008 IF ERL=11038 THEN RESUME 11013 ELSE CLS:PRINT "PCINPUT ERROR: ROW="I1%"COLUMN="I2%"LENGTH="I3%"ATTRIBUTE="RIGHT$(I1$,LEN(I1$)-6)"  EDIT="I5%"  LINE="ERL:STOP
  15. 11009 REM
  16. 11010 I6%(1)=I6%(4) + ((INSTR(I1$,"B")>0)*-16) + ((INSTR(I1$,"H")>0)*-8):IF I4% AND 16 THEN 11042
  17. 11011 COLOR I6%(1),I6%(2):LOCATE I1%,I2%:PRINT STRING$(I3%,"-");:LOCATE I1%,I2%
  18. 11012 I6%=0:I7!=0:I8#=0:MID$(I6$,1,2)=CHR$(0)+CHR$(0):MID$(I7$,1,4)=I6$+I6$:MID$(I8$,1,8)=I7$+I7$:ID%=0:MID$(I0$,1,II%)=STRING$(II%,255):IA%=0:IF LEN(ID$)<=I3% THEN MID$(I0$,1)=ID$:ID%=0:GOTO 11037
  19. 11013 IZ$=" ":IF (ID%<I3%) AND (I4% AND 32) THEN IZ$=MID$(IM$(I5%),ID%+1,1):IF IZ$<>"#" AND IZ$<>"%" THEN I9$=IZ$:I9%=ASC(I9$):GOTO 11018
  20. 11014 I9$=INKEY$:IF I9$="" THEN 11039 ELSE IQ%=INSTR(I0$,CHR$(255))-1:IF LEN(I9$)=1 THEN I9%=ASC(I9$) ELSE I9%=ASC(RIGHT$(I9$,1))
  21. 11015 IF I9%=13 THEN 11022 ELSE IF I9%=27 AND (I4% AND 128) THEN 11013 ELSE IF I9%=27 THEN 11036 ELSE IF I9%=8 THEN 11030
  22. 11016 IF ASC(I9$)<>0 THEN 11018 ELSE IF I9%=71 THEN ID%=0:GOTO 11037 ELSE IF I9%=79 THEN ID%=IA%-1:GOTO 11037 ELSE IF I9%=75 THEN ID%=ID%-1:GOTO 11037 ELSE IF I9%=77 THEN ID%=ID%+1:GOTO 11037 ELSE IF I9%=82 AND IQ%<I3% THEN 11032
  23. 11017 IF I9%=83 AND ID%>-1 THEN 11033 ELSE IF I9%=116 THEN ID%=ID%+2:GOTO 11037 ELSE IF I9%=115 THEN ID%=ID%-2:GOTO 11037 ELSE IF FNIP%(84,93) THEN 11048 ELSE IF FNIP%(94,103) THEN GOSUB 11050:GOTO 11013 ELSE BEEP:GOTO 11014
  24. 11018 IF (I4% AND 32) AND ((IZ$="%" AND INSTR(IA$(1),I9$)>0) OR (IZ$="#" AND INSTR(IA$(2),I9$)>0) OR (IZ$<>"%" AND IZ$<>"#")) THEN 11020
  25. 11019 IF ((I4% AND 1) AND INSTR(IA$(1),CHR$(I9%))>0) OR ((I4% AND 2) AND INSTR(IA$(2),CHR$(I9%))>0) OR ((I4% AND 4) AND INSTR(IA$(I5%),CHR$(I9%))>0) OR ((I4% AND 8) AND INSTR(IC$(I5%),CHR$(I9%))>0) THEN 11020 ELSE BEEP:GOTO 11013
  26. 11020 IF IQ%=I3% AND ID%=I3% THEN BEEP:GOTO 11013 ELSE LOCATE I1%,I2%+ID%:PRINT CHR$(I9%);
  27. 11021 ID%=ID%+1:MID$(I0$,ID%,1)=I9$:IA%=INSTR(I0$,CHR$(255)):IQ%=IA%-1+(-1*(IA%-1=-1)):GOTO 11013
  28. 11022 IF ((I4% AND 64) AND IQ%=0) OR ((I4% AND 32) AND IQ%<>I3%) THEN 11011 ELSE IF IQ%=0 THEN 11036
  29. 11023 IK%=INSTR(IC$(I5%),"."+FNIE$+"."):IF (I4% AND 8) AND IK%<1 THEN 11011 ELSE IF I4% AND 8 THEN GOSUB 11034:GOTO 11036
  30. 11024 IF I4% AND 2 THEN 11025 ELSE 11036
  31. 11025 I8#=VAL(FNIE$):I8$=MKD$(I8#):IF IB#(I5%,1)=0 AND IB#(I5%,2)=0 THEN 11027
  32. 11026 IF I8#<IB#(I5%,1) OR I8#>IB#(I5%,2) THEN 11011
  33. 11027 IF I8#<1000000! AND I8#>-1000000! THEN I7!=I8#:I7$=MKS$(I8#)
  34. 11028 IF I8#<32767 AND I8#>-32765 THEN I6%=I8#:I6$=MKI$(I8#)
  35. 11029 GOTO 11036
  36. 11030 LOCATE I1%,I2%:ID%=ID%-1:IF ID%<0 THEN ID%=0
  37. 11031 MID$(I0$,ID%+1)=MID$(I0$,ID%+2,IA%-(ID%+1))+CHR$(255):GOTO 11037
  38. 11032 LOCATE I1%,I2%:MID$(I0$,ID%+1)=" "+MID$(I0$,ID%+1,IA%-ID%):GOTO 11037
  39. 11033 LOCATE I1%,I2%:MID$(I0$,ID%+1)=MID$(I0$,ID%+2,IA%-(ID%+1))+CHR$(255):GOTO 11037
  40. 11034 IL%=0:FOR IZ%=1 TO IK%:IF MID$(IC$(I5%),IZ%,1)="." THEN IL%=IL%+1
  41. 11035 NEXT IZ%:RETURN
  42. 11036 IA%=INSTR(I0$,CHR$(255)):IQ%=IA%-1+(-1*(IA%-1=-1)):LOCATE I1%,I2%:PRINT FNIE$+STRING$(I3%-IQ%,32);CHR$(0);:ID$="":ON ERROR GOTO 0:IF I%>0 AND I%<II% THEN ID$(I%)=FNIE$:RETURN ELSE RETURN
  43. 11037 IA%=INSTR(I0$,CHR$(255)):IQ%=IA%-1+(-1*(IA%-1=-1)):IF ID%>IA%-1 THEN ID%=IA%-1 ELSE IF ID%<0 THEN ID%=0
  44. 11038 LOCATE I1%,I2%:PRINT FNIE$+STRING$(I3%-IQ%,"-");:LOCATE I1%,I2%+ID%:GOTO 11013
  45. 11039 I6%(4)=I6%(4)+1:IF I6%(4)>3 AND I6%(4)<7 THEN IQ$=CHR$(I6%(7)):GOTO 11041 ELSE IF I6%(4)>9 THEN I6%(4)=0
  46. 11040 IF IA%-1<1 OR INSTR(I1$,"I") > 0 THEN IQ$="-" ELSE IQ$=MID$(I0$,ID%+1,1)
  47. 11041 LOCATE I1%,I2%+ID%:PRINT IQ$;:GOTO 11013
  48. 11042 LOCATE I1%,I2%:COLOR I6%(1),I6%(2):PRINT IO$(I5%);:I6%(1)=I6%(5):I6%(2)=I6%(6):COLOR I6%(1),I6%(2):LOCATE I1%,I2%:FOR IZ%=1 TO I3%*100:NEXT IZ%:GOSUB 11043:GOSUB 11044:ON ERROR GOTO 0:RETURN
  49. 11043 IF I4% AND 256 THEN I9$=INKEY$:IF I9$="" THEN 11043 ELSE RETURN ELSE RETURN
  50. 11044 IF I4% AND 512 THEN PRINT STRING$(LEN(IO$(I5%))," ");:RETURN ELSE RETURN
  51. 11047 REM   CHANGE NEXT LINE FOR ON KEY GOTO FEATURE
  52. 11048 ON I9%-83 GOTO 11014,11014,11014,11014,11014,11014,11014,11014,11014,11014,11014
  53. 11049 REM   CHANGE NEXT LINE FOR ON KEY GOSUB FEATURE
  54. 11050 ON I9%-93 GOSUB 11051,11051,11051,11051,11051,11051,11051,11051,11051,11051,11051
  55. 11051 RETURN
  56. 11999 REM   END OF PCINPUT 1.8 COPYRIGHT 1984 BY CARL R. STATON
  57.