!
!	AFFICHE_CARACTERE
!		Edition des caracteres PXL sous Screen Manager
!
!
!	Remarque : Cette routine utilise elle meme un module C pour
!		convertir les rasters
!

	function affiche_caractere(buffer, abs_column, abs_row)

	implicit integer*4 (A-Z)
	include '($SSDEF)'

	byte buffer(*)

	common /WINDOW/ keyboard, display, matrice, flag_access
	1		,display_2
	character*132	matrice(132)

	common /POSITION/ top, bottom, left, right, phys_col, phys_row,
	1			max_col, max_row

!
!	Creation d'un Keyboard
!
	if (smg$create_virtual_keyboard(keyboard)
	1     		.ne. SS$_NORMAL) then
		type *,'Creation du Keyboard impossible'
	end if

!
!	Creation d'un PASTE_BOARD
!			Clear a l'initialisation

	if (smg$create_pasteboard(board,,phys_row,phys_col,0)
	1		.ne. SS$_NORMAL) then
		type *,'Creation du Board impossible'
		call smg$delete_virtual_keyboard(keyboard)
		return
	end if

!
!	Creation d'un Display
!
	if (smg$create_virtual_display(phys_row, phys_col, display)
	1		.ne. SS$_NORMAL) then
		type *,'Creation du Display impossible'
		call smg$delete_virtual_keyboard(keyboard)
		call smg$delete_pasteboard(board,0)
		return
	end if
!
!	Connection du Display au Board
!
	if (smg$paste_virtual_display(display, board, 1, 1) 
	1		.ne. SS$_NORMAL) then
		type *,'Connection du Display au Board'
		call reset_all
		return
	end if                

!	Message dans une fenetre de message

!	call message

!
!	Initialise la matrice de points
!
	max_col = abs_column
	max_row = abs_row
	flag_access = flag_write
	call init_matrice(buffer)

!
!	Affiche la matrice de points
!
	row = 1
	col = 1

	call display_screen(col,row)

	affiche_caractere = edit_pixel(col, row)

	call sauve_matrice(buffer)

	call reset_all

	return
	end

!
!	RESET_ALL
!		Termine le travail du Screen Manager
!
	subroutine reset_all

	implicit integer*4 (A-Z)

	common /WINDOW/ keyboard, display, matrice, flag_access
	1		,display_2
	character*132	matrice(132)

	call smg$delete_virtual_keyboard(keyboard)
	call smg$delete_virtual_display(display)
c	call smg$delete_virtual_display(display_2)
	call smg$delete_pasteboard(board,0)
             
	return
	end

!
!	INIT_MATRICE
!		Charge la matrice de travail a partir des rasters
!
	subroutine init_matrice(buffer)
	implicit integer*4 (A-Z)

	common /WINDOW/ keyboard, display, matrice, flag_access
	1		,display_2
	character*132	matrice(132)

	common /POSITION/ top, bottom, left, right, phys_col, phys_row,
	1			max_col, max_row

	character*1 car
	byte	visible(8)
       	byte	buffer(*)

	!
	!	Calcul le nombre d'octet dans une ligne du caractere
	!
	nb_col = max_col/32		! Nombre entier de Long Words
	if (nb_col*32 .ne. max_col) 
	1		nb_col = nb_col+1
	nb_col = nb_col*4		! Nombre d'octets
	!
	!	Initialisation de la matrice
	!
	pos_rast = 1
	do l=1, max_row
		do k=0, nb_col-1
		    	call extract_raster(buffer(pos_rast), visible)
			do n=1, 8
	      			if (visible(n) .eq. 0) then
					car = '.'
				else
			   	      	car = '#'
				end if
				matrice(l)(k*8+n:k*8+n) = car
			end do
			pos_rast = pos_rast + 1
		end do
	end do
	!
	!	Definition des pointeurs
	!
	call comput_dim(1,1)

	return
	end

!
!	SAUVE_MATRICE
!
	subroutine sauve_matrice(buffer)
	implicit integer*4 (A-Z)

	common /WINDOW/ keyboard, display, matrice, flag_access
	1		,display_2
	character*132	matrice(132)

	common /POSITION/ top, bottom, left, right, phys_col, phys_row,
	1			max_col, max_row

	character*1 car
	byte	visible(8)
       	byte	buffer(*)

	!
	!	Calcul le nombre d'octet dans une ligne du caractere
	!
	nb_col = max_col/32		! Nombre entier de Long Words
	if (nb_col*32 .ne. max_col) 
	1		nb_col = nb_col+1
	nb_col = nb_col*4		! Nombre d'octets
	!
	!	Initialisation de la matrice
	!
	pos_rast = 1
	do l=1, max_row
	    do k=0, nb_col-1
	    	do n=1, 8
	    	    if (matrice(l)(k*8+n:k*8+n) .eq. '#'
	1	    	.or. matrice(l)(k*8+n:k*8+n) .eq. '*') then
				visible(n) = 1
		    else
				visible(n) = 0
		    end if
		end do
	    	call comput_raster(buffer(pos_rast), visible)
		pos_rast = pos_rast + 1
	    end do
	end do
	return
	end

!
!	DISPLAY_SCREEN
!		Affiche la matrice de points.
!		Controle les limites de l'ecran.
!		Redefinie les bornes de l'affichage
!		(COL, ROW) : Position du point (Haut,Gauche)
!				de l'espace utilisateur
!		
	subroutine display_screen(col,row)
	implicit integer*4 (A-Z)
	include '($SSDEF)'             

	common /WINDOW/ keyboard, display, matrice, flag_access
	1		,display_2
	character*132	matrice(132)

	common /POSITION/ top, bottom, left, right, phys_col, phys_row,
	1     			max_col, max_row

	!                              
	!	Redefinition de la fenetre
	!
	call comput_dim(col, row)
	!            
	!	Affichage
	!               
	do l=1, bottom-row+1
!	    status = smg$put_chars(display,l+1 +1, 1 +1,
!	1			matrice(l+row)(left:right))

	    status=smg$set_cursor_abs(display,l, 1)
	    if (status .ne. SS$_NORMAL) then
		type *,'Set cursor impossible'
		type *,'Row ',row,' - L ',l,' - Row+L ',row+l
		type *,'Top ',top,' - Bottom ',bottom
		type *,'Left ',left,' - Right ',right
		type *,'Max_Col ',max_col,' - Max_Row ',max_row
		type *,'Phys_Col ',phys_col,' - Phys_Row ',phys_row
		type *,'Row ',row,' - Col ',col
		type 10, matrice(l+row)(left:right)
		call smg$return_cursor_pos(display,r,c)
		type *,'Cursor Row ',r,' - Cursor Col ',c
		call lib$stop(%val(status))
	    end if   

	    status=smg$put_line(display,matrice(l-1+row)(left:right),0)
	    if (status .ne. SS$_NORMAL) then
		type *,'Affichage impossible'
		type *,'Row ',row,' - L ',l,' - Row+L ',row+l
		type *,'Top ',top,' - Bottom ',bottom
		type *,'Left ',left,' - Right ',right
		type *,'Max_Col ',max_col,' - Max_Row ',max_row
		type *,'Phys_Col ',phys_col,' - Phys_Row ',phys_row
		type *,'Row ',row,' - Col ',col
		type 10, matrice(l+row)(left:right)
10	    	format(1x,<right-left>A)
		call smg$return_cursor_pos(display,r,c)
		type *,'Cursor Row ',r,' - Cursor Col ',c
		call lib$stop(%val(status))
	    end if
	end do

C	type *,'Row ',row,' - L ',l,' - Row+L ',row+l
C	type *,'Top ',top,' - Bottom ',bottom
C	type *,'Left ',left,' - Right ',right
C	type *,'Max_Col ',max_col,' - Max_Row ',max_row
C	type *,'Phys_Col ',phys_col,' - Phys_Row ',phys_row
C	type *,'Row ',row,' - Col ',col
C	call smg$return_cursor_pos(display,r,c)
C	type *,'Cursor Row ',r,' - Cursor Col ',c

	return
	end

!
!	COMPUT_DIM
!		Calcul les valeurs des bornes de la fenetre affichable
!
	subroutine comput_dim(col, row)

	implicit integer*4 (A-Z)
        
	common /POSITION/ top, bottom, left, right, phys_col, phys_row,
	1			max_col, max_row

	!
	!     	Calcul des dimensions de la fenetre affichable
	!
	top = row
	left = col
	bottom = top + phys_row - 1
	if (bottom .gt. max_row) bottom = max_row
	right  = left + phys_col - 1
	if (right  .gt. max_col) right = max_col
 
	return
	end

!
!	EDIT_PIXEL
!		COL et ROW sont exprimes dans l'espace utilisateur
!
	function edit_pixel(col, row)

	implicit integer*4 (A-Z)
	include '($SSDEF)'
	external SMG$_EOF
                                                                ! KEYPAD
	parameter MV_UP=274, MV_DOWN=275, MV_LEFT=276, 
	1		MV_RIGHT=277				! Fleche
	parameter SCR_UP=268, SCR_DOWN=262, SCR_LEFT=264,
	1		SCR_RIGHT=266				! 8,2,4,6
	parameter CTRL_Z=26, EXIT=290				! F10 (VT200)
	parameter RET_KEY=13					! Return
C	parameter SET=261, RESET=260				! 1,0

	common /WINDOW/ keyboard, display, matrice, flag_access
	1		,display_2
	character*132	matrice(132)

	common /POSITION/ top, bottom, left, right, phys_col, phys_row,
	1	       		max_col, max_row

	character*80 message

	LARG_SCR = phys_col / 2
	HAUT_SCR = phys_row / 2

	do while (.true.)
		call set_cursor(col, row)
		status = smg$read_keystroke(keyboard, key)

c		write (message,*) 'Key ',key
c		type *,'Key ',key
c		call smg$put_chars(display_2,message,1,1)
		
		if (status .ne. SS$_NORMAL .and.
	1		 	status .ne. %loc(SMG$_EOF)) then
		    type *,'EDIT Erreur'
		    type *,'Row  ',row,' - Col ',col
		    type *,'Key ',key,' CTRL_Z ',ctrl_z,' EXIT ',exit
		    call lib$stop(%val(status))
		end if

		! Sortie
		if (key .eq. CTRL_Z .or. key .eq. EXIT
	1			.or. key .eq. RET_KEY) then
	  		call smg$set_cursor_abs(display, 24, 1)
			edit_pixel = key
			return
		end if

c		! Modification

c		if (key .eq. SET) call set_pixel(col,row,1)
c		if (key .eq. RESET) call set_pixel(col,row,0)

		! Deplacement par Fleche

		if (key .eq. MV_UP)    row = row - 1
		if (key .eq. MV_DOWN)  row = row + 1
		if (key .eq. MV_LEFT)  col = col - 1
		if (key .eq. MV_RIGHT) col = col + 1

		! Deplacement par Ecran

	    	if (key .eq. SCR_UP)    row = row - HAUT_SCR
		if (key .eq. SCR_DOWN)  row = row + HAUT_SCR
		if (key .eq. SCR_LEFT)  col = col - LARG_SCR
		if (key .eq. SCR_RIGHT) col = col + LARG_SCR

		! Remise en place du curseur
		
	end do

	return
	end

!
!	SET_PIXEL
!		Modifie un caractere de la matrice
!
	subroutine set_pixel(col, row, value)

	implicit integer*4 (A-Z)
	include '($SSDEF)'

	common /WINDOW/ keyboard, display, matrice, flag_access
	1		,display_2
	character*132	matrice(132)

	if (flag_access .eq. 0) then
		call smg$ring_bell(display)	! Sonne une fois
		return
	end if

	if (value .eq. 0) then
		matrice(row)(col:col) = '_'
	else
		matrice(row)(col:col) = '*'
	end if

	!	Affichage de la nouvelle valeur a la position courante

	status = smg$put_chars(display,matrice(row)(col:col))

	if (status .ne. SS$_NORMAL) then
		type *,'Col ',col,' - Row ',row
		call lib$stop(%val(status))
	end if
	return
	end

!
!	SET_CURSOR
!		Place le curseur. Eventuellement, procede au scrolling
!
	subroutine set_cursor(col, row)
                                                        
	implicit integer*4 (A-Z)
	include '($SSDEF)'

	common /WINDOW/ keyboard, display, matrice, flag_access
	1		,display_2
	character*132	matrice(132)

	common /POSITION/ top, bottom, left, right, phys_col, phys_row,
	1			max_col, max_row
				

	!	Controle la position dans l'espace utilisateur
	!		Utile en cas de deplacement par saut

c	write (message,*) 'Original ',row,col
c	type *,'Original ',row,col
c	call smg$put_chars(display_2,message,2,1)
c	write (message,*) 'Largeur ',left,right
c	type *,'Largeur ',left,right
c	call smg$put_chars(display_2,message,3,1)
c	write (message,*) 'Hauteur ',top,bottom
c	type *,'Hauteur ',top,bottom
c	call smg$put_chars(display_2,message,4,1)
 
	if (row .lt. 1 .or. row .gt. max_row .or.
	1      	col .lt. 1 .or. col .gt. max_col) then

		! Reposition les pointeurs
c		write (message,*) 'Modifie ',row,col
c		type *,'Modifie ',row,col
c		call smg$put_chars(display_2,message,5,1)

		if (row .lt. 1) row = 1
		if (row .gt. max_row) row=max_row
		if (col .lt. 1) col = 1
		if (col .gt. max_col) col=max_col

	end if

	!	Controle la position du curseur dans l'ecran

	if (row .lt. top .or. row .gt. bottom .or.
	1	col .lt. left .or. col .gt. right) then

		! Redefinie le coin de reference

		if (row .lt. top)    loc_row = row
		if (row .gt. bottom) loc_row = top + row - bottom
		if (col .lt. left)   loc_col = col
	      	if (col .gt. right)  loc_col = left + col - right

c		write (message,*) 'Locale ',loc_row, loc_col
c		type *,'Locale ',loc_row, loc_col
c		call smg$put_chars(display_2,message,6,1)

		! Controle la redefinition  -	Securite

		if (loc_row .gt. max_row
	1		.or. loc_col .gt. max_col) then

			if (loc_row .gt. max_row) 
	1			loc_row = max_row - phys_row
			if (loc_col .gt. max_col) 
	1			loc_col = max_col - phys_col
		end if

		if (loc_row .lt. 1 .or. loc_col .lt. 1) then

			if (loc_row .lt. 1) loc_row = 1
			if (loc_col .lt. 1) loc_col = 1
		end if
                                               
c		write (message,*) 'Loc corr ',loc_row,loc_col
c		type *,'Loc corr ',loc_row,loc_col
c		call smg$put_chars(display_2,message,7,1)

		! 	Affichage normalise

		call display_screen(loc_col, loc_row)
	end if

	! Affichage du curseur

	curs_col = col - left + 1
	curs_row = row - top + 1

c	write (message,*) 'Curseur ',loc_row, loc_col
c	type *,'Curseur ',loc_row, loc_col
c	call smg$put_chars(display_2,message,8,1)

	status=smg$set_cursor_abs(display, curs_row, curs_col)
	if (status .ne. SS$_NORMAL) then
		type *,'Set cursor impossible'
	    	type *,'Row      ',row,     ' - Col      ',col
		type *,'Curs Row ',curs_row,' - Curs Col ',curs_col
		type *,'Loc Row  ',loc_row, ' - Loc Col  ',loc_col
		type *,'Top      ',top,     ' - Bottom   ',bottom
		type *,'Left     ',left,    ' - Right    ',right
		type *,'Max_Col  ',max_col, ' - Max_Row  ',max_row
		type *,'Phys_Col ',phys_col,' - Phys_Row ',phys_row
		call smg$return_cursor_pos(display,r,c)
		type *,'Act Row  ',r,       ' - Act Col  ',c
		call lib$stop(%val(status))
	end if

	return
	end
                                                           
!	Creation d'une fenetre de message

	subroutine message

	implicit integer*4 (A-Z)
	include '($SSDEF)'
	include '($SMGDEF)'

	common /WINDOW/ keyboard, display, matrice, flag_access
	1		,display_2
	character*132	matrice(132)
!
!	Creation d'un Display
!
	if (smg$create_virtual_display(12, 25, display_2, 
	1					SMG$M_BORDER)
	1		.ne. SS$_NORMAL) then
		type *,'Creation du Display Erreur impossible'
		call smg$delete_virtual_keyboard(keyboard)
		call smg$delete_pasteboard(board,0)
		return
	end if
!
!	Connection du Display au Board
!
	if (smg$paste_virtual_display(display_2, board, 2, 54) 
	1		.ne. SS$_NORMAL) then
		type *,'Connection du Display Erreur au Board'
		call reset_all
		return
	end if                

	return
	end
