"SfR Fresh" - the SfR Freeware/Shareware Archive

Member "usr/xb-6.2.3/demo/aback.x" of archive xbasic-6.2.3-linux-i386.tar.gz:


As a special service "SfR Fresh" has tried to format the requested source page into HTML format using source code syntax highlighting with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. That can be also achieved for any archive member file by clicking within an archive contents listing on the first character of the file(path) respectively on the according byte size field.
    1 '
    2 '
    3 ' ####################
    4 ' #####  PROLOG  #####
    5 ' ####################
    6 '
    7 PROGRAM	"aback"
    8 VERSION	"0.0001"
    9 '
   10 IMPORT	"xst"
   11 '
   12 DECLARE FUNCTION  Entry ()
   13 '
   14 '
   15 ' ######################
   16 ' #####  Entry ()  #####
   17 ' ######################
   18 '
   19 FUNCTION  Entry ()
   20 '
   21 	XstClearConsole()
   22 '
   23 	upper = 255
   24 	DIM user[upper]
   25 	FOR i = 0 TO upper
   26 		SELECT CASE TRUE
   27 			CASE (i == 0x09)	: user[i] = 0		' no backslash tab
   28 			CASE (i == 0x0A)	: user[i] = 0		' no backslash newline
   29 			CASE (i == 0x0D)	: user[i] = 0		' no backslash return
   30 			CASE (i == 0x1E)	: user[i] = 0		' no backslash test == up-arrow, maybe
   31 			CASE (i == 0x1F)	: user[i] = 0		' no backslash test == down-arrow, maybe
   32 			CASE (i <= 0x1F)	: user[i] = 1		' do backslash codes
   33 			CASE (i == 0x22)	: user[i] = 1		' do backslash of "
   34 			CASE (i == 0x5C)	: user[i] = 1		' do backslash of \
   35 			CASE (i == 0xFE)	: user[i] = 1		' do backslash test \xFE
   36 			CASE (i == 0xFF)	: user[i] = 1		' do backslash test \xFF
   37 			CASE ELSE					: user[i] = 0		' no backslash
   38 		END SELECT
   39 	NEXT i
   40 '
   41 	a0$ = ""
   42 	FOR i = 0x00 TO 0x3F
   43 		a0$ = a0$ + CHR$(i)
   44 	NEXT i
   45 '
   46 	a1$ = ""
   47 	FOR i = 0x40 TO 0x7F
   48 		a1$ = a1$ + CHR$(i)
   49 	NEXT i
   50 '
   51 	a2$ = ""
   52 	FOR i = 0x80 TO 0xBF
   53 		a2$ = a2$ + CHR$(i)
   54 	NEXT i
   55 '
   56 	a3$ = ""
   57 	FOR i = 0xC0 TO 0xFF
   58 		a3$ = a3$ + CHR$(i)
   59 	NEXT i
   60 '
   61 	PRINT "\n\n#####"
   62 	PRINT "a : binary"
   63 	PRINT "b : XstBinStringToBackString$()"
   64 	PRINT "c : XstBinStringToBackStringNL$()"
   65 	PRINT "d : XstBinStringToBackStringThese$()";
   66 '
   67 	PRINT "\n\n#####  0x00 to 0x3F  #####";
   68 	b$ = a0$ : p$ = "a : " : GOSUB Print
   69 	b$ = XstBinStringToBackString$ (@a0$) : p$ = "b : " : GOSUB Print
   70 	b$ = XstBinStringToBackStringNL$ (@a0$) : p$ = "c : " : GOSUB Print
   71 	b$ = XstBinStringToBackStringThese$ (@a0$, @user[]) : p$ = "d : " : GOSUB Print
   72 '
   73 	PRINT "\n\n#####  0x40 to 0x7F  #####";
   74 	b$ = a1$ : p$ = "a : " : GOSUB Print
   75 	b$ = XstBinStringToBackString$ (@a1$) : p$ = "b : " : GOSUB Print
   76 	b$ = XstBinStringToBackStringNL$ (@a1$) : p$ = "c : " : GOSUB Print
   77 	b$ = XstBinStringToBackStringThese$ (@a1$, @user[]) : p$ = "d : " : GOSUB Print
   78 '
   79 	PRINT "\n\n#####  0x80 to 0xBF  #####";
   80 	b$ = a2$ : p$ = "a : " : GOSUB Print
   81 	b$ = XstBinStringToBackString$ (@a2$) : p$ = "b : " : GOSUB Print
   82 	b$ = XstBinStringToBackStringNL$ (@a2$) : p$ = "c : " : GOSUB Print
   83 	b$ = XstBinStringToBackStringThese$ (@a2$, @user[]) : p$ = "d : " : GOSUB Print
   84 '
   85 	PRINT "\n\n#####  0xC0 to 0xFF  #####";
   86 	b$ = a3$ : p$ = "a : " : GOSUB Print
   87 	b$ = XstBinStringToBackString$ (@a3$) : p$ = "b : " : GOSUB Print
   88 	b$ = XstBinStringToBackStringNL$ (@a3$) : p$ = "c : " : GOSUB Print
   89 	b$ = XstBinStringToBackStringThese$ (@a3$, @user[]) : p$ = "d : " : GOSUB Print
   90 	PRINT
   91 	RETURN
   92 '
   93 '
   94 ' *****  Print  *****
   95 '
   96 SUB Print
   97 	PRINT
   98 	PRINT p$;
   99 	upper = UBOUND (b$)
  100 	FOR i = 0 TO upper
  101 		c = b${i}
  102 		IF (c = 0x0A) THEN c = 'n'
  103 		PRINT CHR$(c);
  104 	NEXT i
  105 END SUB
  106 END FUNCTION
  107 END PROGRAM