home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0020 - 0029 / ibm0020-0029 / ibm0028.tar / ibm0028 / DISKEXPL.ZIP / BITSHIFT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-10-23  |  1.1 KB  |  32 lines
  1. 10  DIM LT$(15):LT$(0)="0":LT$(1)="1":LT$(2)="2":LT$(3)="3":LT$(4)="4":LT$(5)="5":LT$(6)="6":LT$(7)="7":LT$(8)="8":LT$(9)="9":LT$(10)="A":LT$(11)="B":LT$(12)="C":LT$(13)="D":LT$(14)="E":LT$(15)="F"
  2. 20  CLS:PRINT"BIT SHIFTING ROUTINE"
  3. 25  DEF SEG=0:POKE &H417,(PEEK(&H417) OR &H40)
  4. 30  PRINT""
  5. 40  PRINT"PLEASE TYPE THE STRING TO BE SHIFTED.":PRINT"":INPUT SI$
  6. 50  PRINT""
  7. 60  PRINT"USE THE UP ARROW TO SEE THE STRING"
  8. 70  PRINT"USE THE LEFT ARROW TO SHIFT THE STRING LEFT"
  9. 80  PRINT"USE THE RIGHT ARROW TO SHIFT THE STRING RIGHT"
  10. 90  PRINT"USE THE F1 KEY TO RESTART PROGRAM"
  11. 100  PRINT""
  12. 110  SI%=LEN(SI$):IF SI%<2 GOTO 40
  13. 120  FOR I%=1 TO SI%:A$=MID$(SI$,I%,1)
  14. 130  FOR J%=0 TO 15:IF A$=LT$(J%) GOTO 160
  15. 140  NEXT J%
  16. 150  PRINT"ILLEGAL CHARACTER IN STRING!!!!":GOTO 40
  17. 160  NEXT I%
  18. 170  KEY(11)ON:KEY(12)ON:KEY(13)ON:KEY(1)ON
  19. 180  ON KEY (11) GOSUB 260
  20. 190  ON KEY (12) GOSUB 230
  21. 200  ON KEY (13) GOSUB 270
  22. 210  ON KEY(1) GOSUB 20
  23. 220  GOTO 180
  24. 230  C8%=0:FOR I%=1 TO SI%:A$=MID$(SI$,I%,1):A%=VAL("&H"+A$):B%=INT(A%/2):C%=2*B%:D%=B%+C8%:C8%=8:IF A%=C% THEN C8%=0
  25. 240  A$=LT$(D%):MID$(SI$,I%,1)=A$
  26. 250  NEXT I%
  27. 260  PRINT SI$:RETURN
  28. 270  C8%=0:FOR I%=SI% TO 1 STEP -1:A$=MID$(SI$,I%,1):A%=VAL("&H"+A$):B%=2*A%:C%=INT(B%/2):D%=B%+C8%:C8%=0:IF D%>15 THEN D%=D%-16:C8%=1
  29. 280  A$=LT$(D%):MID$(SI$,I%,1)=A$
  30. 290  NEXT I%
  31. 300  PRINT SI$:RETURN
  32.