Tuesday, October 30, 2007

ABAP LOGO - Dibuja en ABAP!


Este es mi nuevo proyecto...Una copia del lenguaje de programación LOGO, utilizando ABAP.

Que es lo que se puede hacer?

  • Puedes escoger entre cargar o grabar un script.

  • Entiende los siguintes comandos.

    • GOTO

    • WRITE

    • SQUARE

    • FILL_SQUARE

    • TRIANGLE

    • FILL_TRIANGLE

    • RECTANGLE

    • FILL_RECTANGLE

    • HORIZONTAL_LINE

    • VERTICAL_LINE

    • DIAGONAL_LINE



  • Puedes visualizar el gráfico generado o crear una orden de spool.

  • Posee un manejo de errores para los comandos del Script.


Veamos algunas imágenes -:)











Ahora...El código fuente...

*&----------------------------------------------------------------*
*& Report ZABAP_LOGO *
*&----------------------------------------------------------------*
*& Developed by: Alvaro "Blag" Tejada Galindo. *
*& Date: 28/10/2007 *
*&----------------------------------------------------------------*
*& Supported commands: *
*& GOTO *
*& WRITE *
*& SQUARE *
*& FILL_SQUARE *
*& TRIANGLE *
*& FILL_TRIANGLE *
*& RECTANGLE *
*& FILL_RECTANGLE *
*& HORIZONTAL_LINE *
*& VERTICAL_LINE *
*& DIAGONAL_LINE *
*&----------------------------------------------------------------*
report zabap_logo no standard page heading.

*&----------------------------------------------------------------*
* TYPES *
*&----------------------------------------------------------------*
types: begin of ty_lines,
line type string,
end of ty_lines.

*&----------------------------------------------------------------*
* VARIABLES *
*&----------------------------------------------------------------*
data: custom_container type ref to cl_gui_custom_container,
text_editor type ref to cl_gui_textedit,
w_ucomm type sy-ucomm,
w_lines type i,
w_tabix type sy-tabix,
w_tabix_aux type sy-tabix,
w_text(254) type c,
w_file_name type string,
w_long type i,
is_text type c.

data: pos_col type i,
pos_line type i,
p_newcol type i,
text type string,
text_line type string,
value type i,
value2 type i,
draw_flag type c,
second_run type c,
create_spool type c,
w_subrc type sy-subrc,
path type string,
w_save type c,
w_load type c,
fullpath type string.

*&----------------------------------------------------------------*
* INTERNAL TABLES *
*&----------------------------------------------------------------*
data: t_lines type standard table of ty_lines,
t_command type table of string,
t_filetab type filetable.

*&----------------------------------------------------------------*
* CONSTANTS *
*&----------------------------------------------------------------*
constants: line_length type i value 254.

*&----------------------------------------------------------------*
* FIELD-SYMBOLS *
*&----------------------------------------------------------------*
field-symbols: <fs_lines> like line of t_lines,
<fs_command> like line of t_command,
<fs_command_line> like line of t_command,
<fs_filetab> like line of t_filetab.

*&----------------------------------------------------------------*
* SELECTION-SCREEN *
*&----------------------------------------------------------------*
selection-screen begin of block file with frame.
parameters:
p_file type rlgrap-filename,
p_save radiobutton group rapt user-command test default 'X',
p_load radiobutton group rapt.
selection-screen end of block file.

*&----------------------------------------------------------------*
* AT SELECTION-SCREEN OUTPUT *
*&----------------------------------------------------------------*
at selection-screen output.

*&----------------------------------------------------------------*
* AT SELECTION-SCREEN ON VALUE-REQUEST *
*&----------------------------------------------------------------*
at selection-screen on value-request for p_file.
if p_load eq 'X'.
call method cl_gui_frontend_services=>file_open_dialog
exporting
window_title = 'Select file'
default_filename = '*.txt'
file_filter = '*.txt'
changing
file_table = t_filetab
rc = w_subrc.

read table t_filetab index 1
assigning <fs_filetab>.
if <fs_filetab> is assigned.
w_file_name = <fs_filetab>.
p_file = w_file_name.
endif.
else.
call method cl_gui_frontend_services=>file_save_dialog
exporting
window_title = 'Select file'
file_filter = '*.txt'
changing
filename = w_file_name
path = path
fullpath = fullpath.

p_file = fullpath.
endif.

*-----------------------------------------------------------------*
* START-OF-SELECTION *
*-----------------------------------------------------------------*
start-of-selection.
call screen 0100.

*&----------------------------------------------------------------*
*& Module STATUS_0100 OUTPUT *
*&----------------------------------------------------------------*
module status_0100 output.

set pf-status 'STATUS_MAIN'.
set titlebar 'TITLE'.

if draw_flag eq space.
perform call_editor.
else.
leave to list-processing.
endif.

endmodule. " STATUS_0100 OUTPUT

*&----------------------------------------------------------------*
*& Module USER_COMMAND_0100 INPUT *
*&----------------------------------------------------------------*
module user_command_0100 input.

w_ucomm = sy-ucomm.

case w_ucomm.
when 'BACK' or 'CANCEL' or 'EXIT'.
set screen 0.
exit.
when 'SPOOL'.
create_spool = 'X'.
perform show_graphic.
second_run = 'X'.
draw_flag = 'X'.
when 'SHOW'.
perform show_graphic.
second_run = 'X'.
draw_flag = 'X'.
endcase.

endmodule. " USER_COMMAND_0100 INPUT

*&----------------------------------------------------------------*
*& Form call_editor *
*&----------------------------------------------------------------*
form call_editor.

if text_editor is initial.
create object custom_container
exporting
container_name = 'CUSTOM_CONTROL'
exceptions
cntl_error = 1
cntl_system_error = 2
create_error = 3
lifetime_error = 4
lifetime_dynpro_dynpro_link = 5.

create object text_editor
exporting
wordwrap_mode
= cl_gui_textedit=>wordwrap_at_fixed_position
wordwrap_position = line_length
wordwrap_to_linebreak_mode = cl_gui_textedit=>true
parent = custom_container
exceptions
error_cntl_create = 1
error_cntl_init = 2
error_cntl_link = 3
error_dp_create = 4
gui_type_not_supported = 5
others = 6.
endif.

if p_file ne space and p_load eq 'X'.
call function 'GUI_UPLOAD'
exporting
filename = w_file_name
tables
data_tab = t_lines.

if not t_lines[] is initial.
call method text_editor->open_local_file
exporting
file_name = p_file.

call method cl_gui_cfw=>flush.
endif.
endif.

endform. " call_editor

*&---------------------------------------------------------------*
*& Form show_graphic *
*&---------------------------------------------------------------*
form show_graphic.

if second_run eq 'X'.
clear: t_lines,w_lines,w_tabix,text_line.
refresh t_lines.
endif.

if t_lines[] is initial.

call method text_editor->get_line_count
importing
lines = w_lines.

call method cl_gui_cfw=>flush.

do w_lines times.
w_tabix = w_tabix + 1.
call method text_editor->get_line_text
exporting
line_number = w_tabix
importing
text = w_text.

call method cl_gui_cfw=>flush.

append initial line to t_lines
assigning <fs_lines>.
<fs_lines>-line = w_text.
enddo.
endif.

clear w_tabix.

if p_file ne space and create_spool eq 'X'.
new-page print on no dialog keep in spool 'X'.
endif.

loop at t_lines assigning <fs_lines>.
split <fs_lines>-line at space into table t_command.
loop at t_command assigning <fs_command>.
w_tabix = sy-tabix.
translate <fs_command> to upper case.
case <fs_command>.
when 'GOTO'.
clear is_text.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into pos_col.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into pos_line.
perform goto using pos_col pos_line.
when 'WRITE'.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into text.
while sy-subrc eq 0.
concatenate text_line text
into text_line separated by space.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into text.
if sy-subrc ne 0.
exit.
endif.
w_long = strlen( text ) - 1.
if text+0(1) eq '"' or text+w_long(1) eq '"'.
concatenate text_line text
into text_line separated by space.
replace all occurrences of '"' in text_line
with space.
condense text_line.
exit.
endif.
endwhile.
is_text = 'X'.
perform write_text using text_line.
when 'DRAW'.
clear is_text.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
assigning <fs_command_line>.
translate <fs_command_line> to upper case.
case <fs_command_line>.
when 'SQUARE'.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into value.
perform draw_square using value.
when 'FILL_SQUARE'.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into value.
perform draw_fill_square using value.
when 'TRIANGLE'.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into value.
perform draw_triangle using value.
when 'FILL_TRIANGLE'.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into value.
perform draw_fill_triangle using value.
when 'RECTANGLE'.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into value.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into value2.
perform draw_rectangle using value value2.
when 'FILL_RECTANGLE'.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into value.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into value2.
perform draw_fill_rectangle using value value2.
when 'HORIZONTAL_LINE'.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into value.
perform draw_horizontal_line using value.
when 'VERTICAL_LINE'.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into value.
perform draw_vertical_line using value.
when 'DIAGONAL_LINE'.
w_tabix = w_tabix + 1.
read table t_command index w_tabix
into value.
perform draw_diagonal_line using value.
when others.
perform show_draw_error using <fs_command_line>.
exit.
endcase.
when others.
if is_text ne 'X'.
perform show_error using <fs_command>.
exit.
endif.
endcase.
endloop.
endloop.

if w_file_name ne space.
call function 'GUI_DOWNLOAD'
exporting
filename = w_file_name
tables
data_tab = t_lines.

if create_spool eq 'X'.
new-page print off.
create_spool = space.
endif.

endif.

endform. " show_graphic

*&----------------------------------------------------------------*
*& Form goto *
*&----------------------------------------------------------------*
form goto using p_col
p_line.

leave to list-processing.

skip to line pos_line.
position pos_col.

endform. " goto

*&----------------------------------------------------------------*
*& Form draw_square *
*&----------------------------------------------------------------*
form draw_square using p_value.

clear w_tabix.

w_tabix_aux = pos_line - 1.

do p_value times.
w_tabix = w_tabix + 1.
if w_tabix eq 1.
do p_value times.
w_tabix_aux = w_tabix_aux + 1.
write at w_tabix_aux '*'.
enddo.
elseif w_tabix eq p_value.
write:/ ''.
clear w_tabix_aux.
w_tabix_aux = pos_line - 1.
do p_value times.
w_tabix_aux = w_tabix_aux + 1.
write at w_tabix_aux '*'.
enddo.
else.
write at /pos_line '*'.
p_newcol = pos_line + p_value - 1.
write at p_newcol '*'.
endif.
enddo.

endform. " draw_square

*&----------------------------------------------------------------*
*& Form draw_fill_square *
*&----------------------------------------------------------------*
form draw_fill_square using p_value.

clear w_tabix.

do p_value times.
w_tabix_aux = pos_line - 1.
do p_value times.
w_tabix_aux = w_tabix_aux + 1.
write at w_tabix_aux '*'.
enddo.
write:/ ''.
enddo.

endform. " draw_fill_square

*&----------------------------------------------------------------*
*& Form draw_triangle *
*&----------------------------------------------------------------*
form draw_triangle using p_value.

data: w_number type i,
w_times type i,
w_pos_col type i,
w_pos_line type i,
w_tabix_tri type i,
w_end_value type i.

clear w_tabix.

w_tabix_aux = pos_line - 1.

w_number = p_value mod 2.
w_end_value = p_value - 1.
if w_number ne 0.
w_times = ( p_value + 1 ) / 2.
do w_times times.
w_tabix = w_tabix + 1.
if w_tabix eq 1.
w_tabix_aux = pos_line + w_times.
write at w_tabix_aux '*'.
elseif w_tabix eq w_end_value.
write:/ ''.
w_tabix_aux = pos_line.
do p_value times.
w_tabix_aux = w_tabix_aux + 1.
write at w_tabix_aux '*'.
enddo.
else.
w_tabix_aux = w_tabix_aux - w_tabix + 1.
write at /w_tabix_aux '*'.
w_tabix_tri = w_tabix_tri + 1.
w_tabix_aux = w_tabix_aux + w_tabix.
w_tabix = w_tabix + 1.
write at w_tabix_aux '*'.
endif.
enddo.
endif.

endform. " draw_triangle

*&----------------------------------------------------------------*
*& Form draw_fill_triangle *
*&----------------------------------------------------------------*
form draw_fill_triangle using p_value.

data: w_number type i,
w_times type i,
w_pos_col type i,
w_pos_line type i,
w_tabix_tri type i,
w_end_value type i,
w_tabix_fill type i.

clear w_tabix.

w_tabix_aux = pos_line - 1.

w_number = p_value mod 2.
w_end_value = p_value - 1.
if w_number ne 0.
w_times = ( p_value + 1 ) / 2.
do w_times times.
w_tabix = w_tabix + 1.
if w_tabix eq 1.
w_tabix_aux = pos_line + w_times.
write at w_tabix_aux '*'.
elseif w_tabix eq w_end_value.
write:/ ''.
w_tabix_aux = pos_line.
do p_value times.
w_tabix_aux = w_tabix_aux + 1.
write at w_tabix_aux '*'.
enddo.
else.
w_tabix_aux = w_tabix_aux - w_tabix + 1.
w_tabix_fill = w_tabix_aux.
write at /w_tabix_aux '*'.
w_end_value = w_tabix_aux.
w_tabix_tri = w_tabix_tri + 1.
w_tabix_aux = w_tabix_aux + w_tabix.
w_tabix = w_tabix + 1.
w_tabix_fill = w_tabix_aux - w_tabix_fill.
do w_tabix_fill times.
w_end_value = w_end_value + 1.
write at w_end_value '*'.
enddo.
endif.
enddo.
endif.

endform. " draw_fill_triangle

*&----------------------------------------------------------------*
*& Form write_text *
*&----------------------------------------------------------------*
form write_text using p_text.

write at pos_line p_text.

endform. " write_text

*&----------------------------------------------------------------*
*& Form draw_rectangle *
*&----------------------------------------------------------------*
form draw_rectangle using p_value
p_value2.

data: w_number type i.
clear w_tabix.

w_number = pos_line + p_value - 1.
w_tabix_aux = pos_line - 1.

do p_value2 times.
w_tabix = w_tabix + 1.
if w_tabix eq 1.
do p_value times.
w_tabix_aux = w_tabix_aux + 1.
write at w_tabix_aux '*'.
enddo.
elseif w_tabix eq p_value2.
write:/ ''.
clear w_tabix_aux.
w_tabix_aux = pos_line - 1.
do p_value times.
w_tabix_aux = w_tabix_aux + 1.
write at w_tabix_aux '*'.
enddo.
else.
write at /pos_line '*'.
write at w_number '*'.
endif.
enddo.

endform. " draw_rectangle

*&----------------------------------------------------------------*
*& Form draw_fill_fill_rectangle *
*&----------------------------------------------------------------*
form draw_fill_rectangle using p_value
p_value2.

clear w_tabix.

do p_value2 times.
w_tabix_aux = pos_line - 1.
do p_value times.
w_tabix_aux = w_tabix_aux + 1.
write at w_tabix_aux '*'.
enddo.
write:/ ''.
enddo.

endform. " draw_fill_rectangle

*&----------------------------------------------------------------*
*& Form show_error *
*&----------------------------------------------------------------*
form show_error using p_command.

if p_command eq 'SQUARE' or
p_command eq 'FILL_SQUARE' or
p_command eq 'TRIANGLE' or
p_command eq 'FILL_TRIANGLE' or
p_command eq 'RECTANGLE' or
p_command eq 'FILL_RECTANGLE' or
p_command eq 'HORIZONTAL_LINE' or
p_command eq 'VERTICAL_LINE' or
p_command eq 'DIAGONAL_LINE'.
exit.
endif.

if p_command na '0123456789'.
write:/ 'The command', p_command, 'doesn''t exist.' &
'Please check your script.'.
endif.

endform. " show_error

*&----------------------------------------------------------------*
*& Form show_draw_error *
*&----------------------------------------------------------------*
form show_draw_error using p_command_line.

if p_command_line na '0123456789'.
write:/ 'The command', p_command_line, 'doesn''t exist.' &
'Please check your script.'.
endif.

endform. " show_draw_error

*&----------------------------------------------------------------*
*& Form draw_horizontal_line *
*&----------------------------------------------------------------*
form draw_horizontal_line using p_value.

clear w_tabix.

w_tabix_aux = pos_line - 1.

do p_value times.
w_tabix_aux = w_tabix_aux + 1.
write at w_tabix_aux '*'.
enddo.

endform. " draw_horizontal_line

*&----------------------------------------------------------------*
*& Form draw_vertical_line *
*&----------------------------------------------------------------*
form draw_vertical_line using p_value.

clear w_tabix.

w_tabix_aux = pos_line - 1.

do p_value times.
write at /w_tabix_aux '*'.
enddo.

endform. " draw_vertical_line

*&----------------------------------------------------------------*
*& Form draw_vertical_line *
*&----------------------------------------------------------------*
form draw_diagonal_line using p_value.

clear w_tabix.

w_tabix_aux = pos_line - 1.

do p_value times.
w_tabix_aux = w_tabix_aux + 1.
write at /w_tabix_aux '*'.
enddo.

endform. " draw_vertical_line


Para su conveniencia, pueden obtener el código del Google Project abaplogo en el formato SAPLink.

Si no tienen SAPLink, les recomiendo que lo descarguen y lo instalen -;)

También, sientase libres de modificar el programa.

Saludos,

Blag.

Technorati tags:

No comments: