
C RADIX.FOR 
C NOVEMBER, 1981
C
C CONVERSION IS DONE BY ACCEPTING INTEGER VALUE USING INTEGER,OCTAL,HEX OR
C ASCII FORMAT STATEMENTS, THEN WRITING THE SAME INTEGER USING ALL FOUR
C FORMAT STATEMENTS (OMITTING ASCII IF IT IS NON-PRINTING CHARACTER).
C
C SPECIAL CASE OF BINARY NUMBERS IS HANDLED BY READING AND WRITING THEIR
C CHARACTER STRING EQUIVALENTS.
C
c v2.0 Dec-1985 rewritten as test of screen handling library routines
c               while waiting for testors to get their system up.
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                     data definition
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
c local data for .MAIN.
c
	LOGICAL   journal_on
	LOGICAL   vt100_status,radix_status
	LOGICAL   move_left,move_right
	BYTE line_start,line_position
	BYTE keyboard_input
	INTEGER*4 long_data
	DATA line_start/10/
	DATA line_position/3/
	DATA move_left/.FALSE./
	DATA move_right/.FALSE./
	DATA journal_on /.FALSE./
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                       executable
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
c draw the screen
c
	CALL vt100_clear_screen(vt100_status)
	CALL vt100_draw_box(0,0,79,23,vt100_status)
	CALL vt100_move_cursor(31,0,vt100_status)
	CALL vt100_reverse_video_on(vt100_status)
	CALL vt100_write('** Son of Radix **',18,vt100_status)
	CALL vt100_attributes_off(vt100_status)
	CALL vt100_fill_buffer(2,6,'Enter Number:',13,vt100_status)
	CALL vt100_fill_buffer(2,8,'Octal',5,vt100_status)
	CALL vt100_fill_buffer(2,9,'Decimal',7,vt100_status)
	CALL vt100_fill_buffer(2,10,'Hex',3,vt100_status)
	CALL vt100_fill_buffer(2,11,'ASCII',5,vt100_status)
	CALL vt100_fill_buffer(2,12,'Binary',6,vt100_status)
	CALL vt100_fill_buffer(6,15,
     &    'Select RADIX you want to input using arrow keys and <RETURN>'
     &    ,60,vt100_status)
	CALL vt100_fill_buffer(6,16,
     &    'or by typing B, O, D, H, A or E.'
     &    ,32,vt100_status)
	CALL vt100_fill_buffer(6,18,
     &    'When entering numbers a <CTRL>Z or an error get you back to'
     &    ,59,vt100_status)
	CALL vt100_fill_buffer(6,19,
     &    'the command line.  Use <BACKSPACE> in place of <DELETE>.'
     &    ,56,vt100_status)
	CALL vt100_fill_buffer(6,21,
     &    'Toggle journaling on/off with J typed while on command line.'
     &    ,60,vt100_status)
	CALL vt100_fill_buffer(32,23,'Journal Off',11,vt100_status)
	CALL VT100_dump_buffer

c
c
c select radix of binary, octal, decimal, hex or ASCII
c
	DO WHILE (line_position .NE. 6)
		CALL vt100_beep(vt100_status)
		CALL write_command_line(line_start,line_position)
		DO WHILE (keyboard_input .NE. "15)
			keyboard_input = 0
			CALL vt100_read_noecho(keyboard_input,vt100_status)
			CALL shall_we_move(keyboard_input,move_right,move_left)
			IF (move_right) THEN
				line_position = line_position + 1
				IF (line_position .GT. 6) THEN
					line_position = 1
				ENDIF
				CALL write_command_line(line_start,line_position)
				move_right = .FALSE.
			ELSE IF (move_left) THEN
				line_position = line_position - 1
				IF (line_position .LT. 1) THEN
					line_position = 6
				ENDIF
				CALL write_command_line(line_start,line_position)
				move_left = .FALSE.
			ELSE
				CALL shall_we_jump(keyboard_input,line_position,journal_on)
			ENDIF
			CALL write_command_line(line_start,line_position)
		ENDDO
c
c
c read and convert a number
c
		radix_status = .TRUE.
		DO WHILE (radix_status)
			CALL input_longword(line_position,long_data,radix_status)
			IF (radix_status) THEN
				CALL output_longword(long_data,journal_on,radix_status)
			ENDIF
		ENDDO
		keyboard_input = 0
	ENDDO
	CALL vt100_clear_screen(vt100_status)
	IF (journal_on) THEN
		CLOSE(UNIT=1)
	ENDIF
	STOP
c
c
c error routines
c
9999	WRITE(5,*) '**ERROR** .MAIN. VT100 escape sequence failure'
	STOP
c
c
c formats
c
10	FORMAT(A1)
	END
c
c
c
	SUBROUTINE shall_we_move(keyboard_input,move_left,move_right)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c checks to see if VT100 arrow key was hit
c Input:  keyboard character
c Output: move left and move right logicals
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                     data definition
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
	LOGICAL   vt100_status
	LOGICAL   move_left,move_right
	BYTE	  keyboard_input
	BYTE	  local_keyboard_input
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                       executable
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
	IF (keyboard_input .EQ. "33) THEN
		CALL vt100_read_noecho(local_keyboard_input,vt100_status)
		IF (local_keyboard_input .EQ. '[') THEN
			CALL vt100_read_noecho(local_keyboard_input,vt100_status)
			IF (local_keyboard_input .EQ. 'D') THEN
				move_right = .TRUE.
			ELSE IF (local_keyboard_input .EQ. 'C') THEN
				move_left = .TRUE.
			ENDIF
		ENDIF
	ENDIF
	RETURN
	END
c
c
c
c
	SUBROUTINE shall_we_jump(keyboard_input,line_position,journal_on)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c checks to see if VT100 arrow key was hit
c Input:  keyboard character
c Output: move left and move right logicals
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                     data definition
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
	LOGICAL journal_on
	BYTE keyboard_input,local_keyboard_input,line_position
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                       executable
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
	local_keyboard_input = keyboard_input
	IF (local_keyboard_input .GT. "140) THEN
		local_keyboard_input = keyboard_input - "40
	ENDIF
	IF (local_keyboard_input .EQ. 'B') THEN
		line_position = 1
                keyboard_input = "15
	ELSE IF (local_keyboard_input .EQ. 'O') THEN
		line_position = 2
                keyboard_input = "15
	ELSE IF (local_keyboard_input .EQ. 'D') THEN
		line_position = 3
                keyboard_input = "15
	ELSE IF (local_keyboard_input .EQ. 'H') THEN
		line_position = 4
                keyboard_input = "15
	ELSE IF (local_keyboard_input .EQ. 'A') THEN
		line_position = 5
                keyboard_input = "15
	ELSE IF (local_keyboard_input .EQ. 'E') THEN
		line_position = 6
                keyboard_input = "15
	ELSE IF (local_keyboard_input .EQ. 'J') THEN
		CALL vt100_move_cursor(40,23,vt100_status)
		IF (journal_on .EQ. .FALSE.) THEN
			journal_on = .TRUE.
			OPEN(UNIT=1,NAME='radix.dat',STATUS='NEW')
			CALL vt100_write('On ',3,vt100_status)
		ELSE
			journal_on = .FALSE.
			CLOSE(UNIT=1)
			CALL vt100_write('Off',3,vt100_status)
		ENDIF		
	ENDIF
	RETURN
	END
c
c
c
	SUBROUTINE write_command_line(line_start,line_position)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c writes the radix selection line
c Input:  start position of command line current position
c Output: to screen only
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                     data definition
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
	LOGICAL vt100_status
	BYTE line_start,line_position
	BYTE last_position
	CHARACTER*10 line_item(6),write_buffer
	DATA last_position/-1/
	DATA line_item(1)/'Binary    '/
	DATA line_item(2)/'Octal     '/
	DATA line_item(3)/'Decimal   '/
	DATA line_item(4)/'Hex       '/
	DATA line_item(5)/'ASCII     '/
	DATA line_item(6)/'Exit      '/
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                       executable
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
	IF (line_position .NE. last_postion) THEN
		last_position = line_position
		CALL vt100_move_cursor(line_start,4,vt100_status)
		CALL vt100_write(
     &             'Binary    Octal     Decimal
     &   Hex       ASCII     Exit      ',
     &              60,vt100_status)
		CALL vt100_move_cursor( (line_start+(line_position*10)-10),
     &                                   4,vt100_status)
		CALL vt100_blink_on(vt100_status)
		WRITE(5,20)(line_item(line_position))
		CALL vt100_attributes_off(vt100_status)
		CALL vt100_move_cursor( (line_start+(line_position*10)-10),
     &                                   4,vt100_status)
	ENDIF
	RETURN
20	FORMAT('+',A10,$)
	END
c
c
c
	SUBROUTINE output_longword (long_data,journal_on,radix_status)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c write the output data to the screen
c Input:  input value as integer
c Output: status of write
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                     data definition
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
c local data
c
	LOGICAL   journal_on
	LOGICAL   vt100_status,radix_status
	CHARACTER BINARY(32)
	BYTE      byte_in_long_data(4)
	INTEGER*2 word_in_long_data(2)
	INTEGER*4 long_data,long_data_local,high_byte,low_byte,iascii,do_index
	EQUIVALENCE (long_data_local,word_in_long_data)
	EQUIVALENCE (long_data_local,byte_in_long_data)
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                       executable
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c WRITE OUTPUT FOR longword
c
	long_data_local = long_data
	radix_status = .TRUE.
	CALL vt100_reverse_video_on(vt100_status)
c
c
c octal output
c
	CALL vt100_move_cursor(9,8,vt100_status) 	!longword
	WRITE(5,501,ERR=100) long_data

	CALL vt100_move_cursor(25,8,vt100_status)	!word
	WRITE(5,2501,ERR=100) word_in_long_data(2)
	CALL vt100_move_cursor(35,8,vt100_status)
	WRITE(5,2501,ERR=100) word_in_long_data(1)

	CALL vt100_move_cursor(45,8,vt100_status)	!byte
	WRITE(5,4501,ERR=100) byte_in_long_data(4)
	CALL vt100_move_cursor(50,8,vt100_status)
	WRITE(5,4501,ERR=100) byte_in_long_data(3)
	CALL vt100_move_cursor(55,8,vt100_status)
	WRITE(5,4501,ERR=100) byte_in_long_data(2)
	CALL vt100_move_cursor(60,8,vt100_status)
	WRITE(5,4501,ERR=100) byte_in_long_data(1)
c
c
c decimal output
c
	CALL vt100_move_cursor(9,9,vt100_status)	!longword
	WRITE(5,50,ERR=100) long_data

	CALL vt100_move_cursor(25,9,vt100_status)	!word
	WRITE(5,2500,ERR=100) word_in_long_data(2)
	CALL vt100_move_cursor(35,9,vt100_status)
	WRITE(5,2500,ERR=100) word_in_long_data(1)

	CALL vt100_move_cursor(45,9,vt100_status)	!byte
	WRITE(5,4500,ERR=100) byte_in_long_data(4)
	CALL vt100_move_cursor(50,9,vt100_status)
	WRITE(5,4500,ERR=100) byte_in_long_data(3)
	CALL vt100_move_cursor(55,9,vt100_status)
	WRITE(5,4500,ERR=100) byte_in_long_data(2)
	CALL vt100_move_cursor(60,9,vt100_status)
	WRITE(5,4500,ERR=100) byte_in_long_data(1)
c
c
c hex output
c
	CALL vt100_move_cursor(9,10,vt100_status)	!longword
	WRITE(5,502,ERR=100) long_data

	CALL vt100_move_cursor(25,10,vt100_status)	!word
	WRITE(5,2502,ERR=100) word_in_long_data(2)
	CALL vt100_move_cursor(35,10,vt100_status)
	WRITE(5,2502,ERR=100) word_in_long_data(1)

	CALL vt100_move_cursor(45,10,vt100_status)	!byte
	WRITE(5,4502,ERR=100) byte_in_long_data(4)
	CALL vt100_move_cursor(50,10,vt100_status)
	WRITE(5,4502,ERR=100) byte_in_long_data(3)
	CALL vt100_move_cursor(55,10,vt100_status)
	WRITE(5,4502,ERR=100) byte_in_long_data(2)
	CALL vt100_move_cursor(60,10,vt100_status)
	WRITE(5,4502,ERR=100) byte_in_long_data(1)
c
c
c ASCII output
c
	CALL vt100_move_cursor(15,11,vt100_status)
	WRITE(5,1502)
	DO do_index=1,4
		IF ((byte_in_long_data(do_index) .GE.  32) .AND.
     &		    (byte_in_long_data(do_index) .LE. 126)) THEN
			WRITE(5,1503)byte_in_long_data(do_index)
		ELSE
			WRITE(5,1503)' '
		ENDIF
	ENDDO
c
c
c binary output
c
	CALL build_binary_string(long_data,BINARY)
	CALL vt100_move_cursor(9,12,vt100_status)
	WRITE(5,51,ERR=100)(BINARY(I),I=1,32)
	CALL vt100_attributes_off(vt100_status)

	IF (journal_on) THEN
		WRITE(1,78)
		WRITE(1,79)
		write(1,80)long_data,
     &                     word_in_long_data(2),
     &                     word_in_long_data(1),
     &                     byte_in_long_data(4),
     &                     byte_in_long_data(3),
     &                     byte_in_long_data(2),
     &                     byte_in_long_data(1)
		write(1,81)long_data,
     &                     word_in_long_data(2),
     &                     word_in_long_data(1),
     &                     byte_in_long_data(4),
     &                     byte_in_long_data(3),
     &                     byte_in_long_data(2),
     &                     byte_in_long_data(1)
		write(1,82)long_data,
     &                     word_in_long_data(2),
     &                     word_in_long_data(1),
     &                     byte_in_long_data(4),
     &                     byte_in_long_data(3),
     &                     byte_in_long_data(2),
     &                     byte_in_long_data(1)
		WRITE(1,79)
		WRITE(1,83)
		DO do_index=1,4
			IF ((byte_in_long_data(do_index) .GE.  32) .AND.
     &			    (byte_in_long_data(do_index) .LE. 126)) THEN
				WRITE(1,1503)byte_in_long_data(do_index)
			ELSE
				WRITE(1,1503)' '
			ENDIF
		ENDDO
		WRITE(1,84)(BINARY(I),I=1,32)
	ENDIF
	RETURN
c
c
c error handling address
c
100	CONTINUE
	radix_status = .FALSE.
	RETURN
c
c
c formats
c
50	FORMAT('+',I11,$)
501	FORMAT('+',O11,$)
502	FORMAT('+',Z11,$)
2500	FORMAT('+',I6,$)
2501	FORMAT('+',O6,$)
2502	FORMAT('+',Z6,$)
4500	FORMAT('+',I4,$)
4501	FORMAT('+',O4,$)
4502	FORMAT('+',Z4,$)
1502	FORMAT('+ ',$)
1503	FORMAT('+',A1,$)
51	FORMAT('+',8A1,' ',8A1,' ',8A1,' ',8A1)
78	FORMAT(///,
     & '            Longword        Words               Bytes')
79	FORMAT('            +-----------+   +-----+   +-----+   +---+   +-
     &--+   +---+   +---+')
80	FORMAT(' Octal    ',O14,2(O10),4(O8))
81	FORMAT(' Decimal  ',I14,2(I10),4(I8))
82	FORMAT(' Hex      ',Z14,2(Z10),4(Z8))
83	FORMAT(' ASCII    ',$)
84	FORMAT(' Binary   ',8A1,' ',8A1,' ',8A1,' ',8A1)
95	FORMAT()
96	FORMAT(//)
97	FORMAT('+  ',$)
	END
c
c
c
	SUBROUTINE build_binary_string(long_data,binary_string)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c converts a FORTRAN integer to a character string
c representing the binary equivalent of the integer
c Input:  integer
c Output: string
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                     data definition
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
	CHARACTER binary_string(32)
	CHARACTER string_low(16)
	CHARACTER string_high(16)
	INTEGER*2 words(2)
	INTEGER*4 long_data,long_data_local,imask,do_index,icount
	EQUIVALENCE (long_data_local,words)	
c
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                       executable
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c initialize count and mask
c
c Loop for 32 characters in the string--
c AND together the input number with each power of 2,
c if result is not 0, then insert a '1' in the character string
c corresponding to the current power of 2, else insert a '0'.
c Use two words rather than 1 longword to avoid integer overflow.
c
	long_data_local = long_data
	icount = 32
	DO i = 1,2
		imask  = 1
		DO do_index = 1,16
		        IF ( ( words(i) .AND. imask ) .NE. 0 ) THEN
				binary_string(icount)='1'
		        ELSE
		        	binary_string(icount)='0'
		        ENDIF
		        imask  = imask * 2
		        icount = icount - 1
		ENDDO
	ENDDO
c
c
c and return
c
	RETURN
	END
