Piper's Pit BBS/FTP: ibm 0040 - 0049/ibm0040-0049/ibm0040.tar/ibm0040/DBRIEF.ZIP/SOURCE/MACROLIB.M

Text File | 1991-03-21 | 13.6 KB | 606 lines

;dBRIEF MacroLib - v3.10
;Copyright (c) 1990 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
(macro _date_time
    (
        (int                year
                            month
                            day
                            hours
                            minutes
                            seconds
                            operation
        )
        (string            return_string
                            month_string
                            weekday_string
                            year_string
                            ampm
        )
        (get_parm 0 operation)
        (date year month day month_string weekday_string)
        (sprintf year_string "%d" year)
        (= year_string (substr year_string 3 2))
        (time hours minutes seconds)
        (switch operation
            1
                (sprintf return_string "%02d/%02d/%s" month day year_string)
            2
                (sprintf return_string "%d" year)
            3
                (sprintf return_string "%02d:%02d:%02d" hours minutes seconds)
            4
                (
                    (= ampm "a")
                    (if (>= hours 12)
                        (
                            (= ampm "p")
                            (if (!= hours 12)
                                (-= hours 12)
                            )
                        )
                    )
                    (if (== hours 0)
                        (= hours 12)
                    )
                    (sprintf return_string "%02d:%02d %sm" hours minutes ampm)
                )
            5
                (sprintf return_string "%s %d, %d" month_string day year)
        )
        (return return_string)
    )
)
(macro _pad_right
    (
        (int                pad_length
        )
        (string            pad_string
        )
        (get_parm 0 pad_string)
        (get_parm 1 pad_length)
        (= pad_string (trim pad_string))
        (if (< (strlen pad_string) pad_length)
            (return (+ pad_string (_replicate " " (- pad_length (strlen pad_string)))))
        ;else
            (return pad_string)
        )
    )
)
(macro _display_popup_message
    (
        (int                pop_current_buffer
                            pop_display_buffer
                            pop_error
                            pop_screen_lines
                            pop_window_width
                            pop_beep_count
        )
        (string            pop_message_string
                            pop_message_parm
                            pop_temp_str
        )
        (get_parm 0 pop_message_string)
        (get_parm 1 pop_message_parm)
        (get_parm 2 pop_error)
        (if (> (strlen (+ pop_message_string pop_message_parm)) 62)
            (= pop_message_parm (trim (substr pop_message_parm 1 (- 62 (strlen pop_message_string)))))
        )
        (message "")
        (if dbr_message_windows
            (
                (inq_screen_size pop_screen_lines NULL)
                (if (strlen pop_message_parm)
                    (= pop_window_width (+ (strlen (+ pop_message_string pop_message_parm)) 8))
                ;else
                    (= pop_window_width (+ (strlen pop_message_string) 10))
                )
                (= pop_current_buffer (inq_buffer))
                (if pop_error
                    (
                        (while (<= (++ pop_beep_count ) dbr_err_beeps)
                            (beep)
                        )
                        (= pop_display_buffer (create_buffer "Error!" NULL 1))
                    )
                ;else
                    (= pop_display_buffer (create_buffer "Message" NULL 1))
                )
                (if (>= (version) 310)
                    (execute_macro "db_hide 1")
                )
                (create_window (- 80 pop_window_width) (- pop_screen_lines 4) 75 (- pop_screen_lines 8) "[press any key]")
                (if (>= (version) 310)
                    (execute_macro "db_show 1")
                )
                (set_buffer pop_display_buffer)
                (attach_buffer pop_display_buffer)
                (sprintf pop_temp_str pop_message_string pop_message_parm)
                (move_abs 2 3)
                (insert pop_temp_str)
                (refresh)
                (_pause_for_seconds dbr_msg_seconds)
                (delete_window)
                (set_buffer pop_current_buffer)
                (attach_buffer pop_current_buffer)
                (delete_buffer pop_display_buffer)
            )
        ;else
            (
                (if pop_error
                    (while (<= (++ pop_beep_count ) dbr_err_beeps)
                        (beep)
                    )
                )
                (message pop_message_string)
            ;pop_message_parm)
            )
        )
    )
)
(macro _pause_for_seconds
    (
        (int            start_seconds
                        pause_seconds
                        curnt_seconds
        )
        (get_parm 0 pause_seconds)
        (time NULL NULL start_seconds NULL)
        (= start_seconds (% (+ start_seconds pause_seconds) 60))
        (while (&& (!= curnt_seconds start_seconds)(! (inq_kbd_char)))
            (time NULL NULL curnt_seconds NULL)
        )
        (keyboard_flush)
    )
)
(macro _menu_lines
    (
        (int                screen_lines
                            options
        )
        (get_parm 0 options)
        (inq_screen_size screen_lines NULL)
        (if (> screen_lines 24)
            (-= screen_lines 4)
        ;else
            (-= screen_lines 2)
        )
        (if (> (+= options 3) screen_lines)
            (= options screen_lines)
        )
        (return options)
    )
)
(macro _get_directory
    (
        (string            directory
        )
        (inq_names directory NULL NULL)
        (if (rindex directory "\\")
            (= directory (substr directory 1 (rindex directory "\\")))
        )
        (return (upper directory))
    )
)
(macro _replicate
    (
        (int                rep_characters
                            rep_times
        )
        (string            rep_character
                            rep_string
        )
        (get_parm 0 rep_character)
        (get_parm 1 rep_characters)
        (while (<= (++ rep_times) rep_characters)
            (+= rep_string rep_character)
        )
        (return rep_string)
    )
)
(macro _number_lines
    (
        (int                number_lines
        )
        (save_position)
        (end_of_buffer)
        (inq_position number_lines NULL)
        (restore_position)
        (return number_lines)
    )
)
(macro _number_bytes
    (
        (int            number_bytes
        )
        (save_position)
        (top_of_buffer)
        (drop_anchor)
        (end_of_buffer)
        (= number_bytes (inq_mark_size))
        (raise_anchor)
        (restore_position)
        (return number_bytes)
    )
)
(replacement _invalid_key
    (
        (int _key_int)
        (string _key_read)
        (if (== (inq_called) "_pick_menu")
            (
                (= _key_int (& 0xff (read_char)))
                (sprintf _key_read "%c" _key_int)
                (raise_anchor)
                (save_position)
                (move_rel 0 1)
                (= _key_read (+ "<\\c[ \t]@" _key_read))
                (if (! (search_fwd _key_read 1 0))
                    (
                        (top_of_buffer)
                        (if (! (search_fwd _key_read 1 0))
                            (
                                (restore_position)
                                (beep)
                            )
                        )
                    )
                )
                (drop_anchor 3)
                (refresh)
                (_menu_message)
            )
        ;else
            (_invalid_key)
        )
    )
)
(macro _pick_menu
    (
        (int                _mnu_ul_x
                            _mnu_ul_y
                            _mnu_lr_x
                            _mnu_lr_y
                            _mnu_current_buffer
                            _mnu_display_buffer
        )
        (string            _mnu_file
                            _mnu_titl
                            _mnu_inst
                            _mnu_process
                            _mnu_parameter
                            _mouse_macro
        )
        (global            _mnu_parameter
        )
        (get_parm 0 _mnu_file)
        (get_parm 1 _mnu_titl)
        (get_parm 2 _mnu_ul_x)
        (get_parm 3 _mnu_ul_y)
        (get_parm 4 _mnu_lr_x)
        (get_parm 5 _mnu_lr_y)
        (get_parm 6 _mnu_process)
        (get_parm 7 _mnu_display_buffer)
        (get_parm 8 _mnu_inst)
        (get_parm 9 _mouse_macro)
        (set_calling_name "_pick_menu")
        (= _mnu_current_buffer (inq_buffer))
        (if (|| (!= "" _mnu_file)(!= 0 _mnu_display_buffer))
            (
                (keyboard_push)
                (if (! _mnu_display_buffer)
                    (= _mnu_display_buffer (create_buffer _mnu_titl _mnu_file))
                )
                (if (>= (version) 310)
                    (execute_macro "db_hide 0 _pick_action")
                )
                (if (strlen _mnu_inst)
                    (create_window _mnu_ul_x _mnu_ul_y _mnu_lr_x _mnu_lr_y _mnu_inst)
                ;else
                    (create_window _mnu_ul_x _mnu_ul_y _mnu_lr_x _mnu_lr_y "  ─┘ to select")
                )
                (if (>= (version) 310)
                    (execute_macro "db_show 0")
                )
                (set_buffer _mnu_display_buffer)
                (attach_buffer _mnu_display_buffer)
                (top_of_buffer)
                (raise_anchor)
                (drop_anchor 3)
                (refresh)
                (if (strlen _mnu_process)
                    (
                        (sprintf _mnu_parameter "_menu_process %s %d %d" _mnu_process (- _mnu_ul_y _mnu_lr_y) (_number_lines))
                        (execute_macro (+ _mnu_parameter " 0"))
                        (assign_to_key "<Enter>" (+ _mnu_parameter " 13"))
                        (assign_to_key "<Keypad-plus>" (+ _mnu_parameter " 13"))
                        (assign_to_key "<Esc>" (+ _mnu_parameter " 27"))
                        (assign_to_key "<Keypad-minus>" (+ _mnu_parameter " 45"))
                        (assign_to_key "<Up>" (+ _mnu_parameter " 0"))
                        (assign_to_key "<Down>" (+ _mnu_parameter " 1"))
                        (assign_to_key "<PgUp>" (+ _mnu_parameter " 2"))
                        (assign_to_key "<PgDn>" (+ _mnu_parameter " 3"))
                    )
                ;else
                    (
                        (_menu_message 1)
                        (assign_to_key "<Enter>" "_menu_enter")
                        (assign_to_key "<Keypad-plus>" "_menu_enter")
                        (assign_to_key "<Esc>" "_menu_escape")
                        (assign_to_key "<Keypad-minus>" "_menu_escape")
                        (sprintf _mnu_parameter "1 %d" (_number_lines))
                        (assign_to_key "<Up>" (+ "_menu_line -1 " _mnu_parameter))
                        (assign_to_key "<Down>" (+ "_menu_line 1 " _mnu_parameter))
                        (sprintf _mnu_parameter "1 %d %d" (- _mnu_ul_y _mnu_lr_y) (_number_lines))
                        (assign_to_key "<PgUp>" (+ "_menu_page -1 " _mnu_parameter))
                        (assign_to_key "<PgDn>" (+ "_menu_page 1 " _mnu_parameter))
                    )
                )
                (process)
                (keyboard_pop)
                (delete_window)
                (set_buffer _mnu_current_buffer)
                (attach_buffer _mnu_current_buffer)
                (delete_buffer _mnu_display_buffer)
                (message "")
            )
        ;else
            (
                (= temp_str "NULL")
                (_display_popup_message "Cannot create menu. File not found!" "" 1)
            )
        )
    )
)
(macro _pick_action
    (
        (int event
              modifier
              parm2
              parm3
        )
        (get_parm 0 event)
        (get_parm 1 modifier)
        (get_parm 2 parm2)
        (get_parm 3 parm3)
        (switch event
            10      NULL ;BTN1_CLICK:
            13
            (
                (int lines
                        max_lines
                )
                (if (&& (! (inq_position lines))(< 0 parm2))
                    (
                        (= max_lines lines)
                        (while (&& (! (inq_position))(> parm2 lines))
                            (
                                (execute_macro (inq_assignment "<Down>"))
                                (inq_position lines)
                                (if (== max_lines lines)
                                    (break)
                                ;else
                                    (= max_lines lines)
                                )
                            )
                        )
                ;else
                        (while (&& (! (inq_position))(< parm2 lines))
                            (
                                (execute_macro (inq_assignment "<Up>"))
                                (inq_position lines)
                                (if (== max_lines lines)
                                    (break)
                                ;else
                                    (= max_lines lines)
                                )
                            )
                        )
                        (switch event
                            13      ; edit the file
                                (execute_macro (inq_assignment "<Enter>"))
                        )
                    )
                )
            )
            19
                (if (== (inq_assignment "<Esc>") "nothing")
                    (push_back (key_to_int "<Esc>"))
                ;else
                    (execute_macro (inq_assignment "<Esc>"))
                )
            17
            (
                (switch parm2
                    3
                        (execute_macro (inq_assignment "<PgDn>"))
                    2
                        (execute_macro (inq_assignment "<PgUp>"))
                    1
                        (execute_macro (inq_assignment "<Down>"))
                    0
                        (execute_macro (inq_assignment "<Up>"))
                )
            )
        )
    )
)
(macro _menu_process
    (
        (int                _mnu_last_key
                            _mnu_length
                            _mnu_options
        )
        (string            _mnu_process
                            _mnu_text_line
        )
        (get_parm 0 _mnu_process)
        (get_parm 1 _mnu_length)
        (get_parm 2 _mnu_options)
        (get_parm 3 _mnu_last_key)
        (switch _mnu_last_key
            0
                (_menu_line -1 0 _mnu_options)
            1
                (_menu_line 1 0 _mnu_options)
            2
                (_menu_page -1 0 _mnu_length _mnu_options)
            3
                (_menu_page 1 0 _mnu_length _mnu_options)
        )
        (beginning_of_line)
        (= _mnu_text_line (trim (read)))
        (execute_macro _mnu_process _mnu_last_key _mnu_text_line)
    )
)
(macro _menu_message
    (
        (string            _mnu_message
                            _mnu_text_line
        )
        (beginning_of_line)
        (= _mnu_text_line (trim (read)))
        (= _mnu_message (substr _mnu_text_line (+ (index _mnu_text_line "|") 1)))
        (if (!= "|" (substr _mnu_message 1 1))
            (message "%s" _mnu_message)
        )
    )
)
(macro _menu_line
    (
        (int                _dis_message
                            _dis_options
                            _dis_direction
        )
        (get_parm 0 _dis_direction)
        (get_parm 1 _dis_message)
        (get_parm 2 _dis_options)
        (if (|| (&& (== (_menu_position) _dis_options)(== _dis_direction 1))(&& (== (_menu_position) 1)(== _dis_direction -1)))
            (= _dis_direction 0)
        )
        (if (!= _dis_direction 0)
            (
                (raise_anchor)
                (move_rel _dis_direction 0)
                (drop_anchor 3)
                (if _dis_message
                    (_menu_message)
                )
            )
        )
    )
)
(macro _menu_page
    (
        (int                _dis_message
                            _dis_length
                            _dis_options
                            _dis_direction
                            _dis_move
        )
        (extern to_bottom)
        (get_parm 0 _dis_direction)
        (get_parm 1 _dis_message)
        (get_parm 2 _dis_length)
        (get_parm 3 _dis_options)
        (extern to_bottom)
        (= _dis_move (- _dis_length 1))
        (*= _dis_length _dis_direction)
        (if (< (+ (_menu_position) _dis_length) _dis_options)
            (
                (raise_anchor)
                (inq_top_left _dis_length NULL)
                (if (&& (== 1 _dis_direction)(!= (_menu_position) _dis_length))
                    (to_top)
                ;else
                    (
                        (move_rel (* _dis_move _dis_direction) 0)
                        (to_top)
                    )
                )
                (while (inq_position)
                    (move_rel -1 0)
                )
                (drop_anchor 3)
                (if _dis_message
                    (_menu_message)
                )
            )
            ;else
            (
                (raise_anchor)
                (if (== 1 _dis_direction)
                    (
                        (= _dis_move (_menu_position))
                        (move_rel _dis_options 0)
                        (while (inq_position)
                            (move_rel -1 0)
                        )
                        (drop_anchor 3)
                    )
                ;else
                    (
                        (top_of_buffer)
                        (drop_anchor 3)
                    )
                )
                (if _dis_message
                    (_menu_message)
                )
            )
        )
    )
)
(macro _menu_enter
    (
        (string            _mnu_pointer
                            _mnu_text_line
        )
        (beginning_of_line)
        (= _mnu_text_line (trim (read)))
        (= _mnu_pointer (substr _mnu_text_line (+ (index _mnu_text_line ";") 1)))
        (= _mnu_pointer (substr _mnu_pointer 1 (- (index _mnu_pointer "|") 1)))
        (= temp_str (trim _mnu_pointer))
        (message "")
        (exit)
    )
)
(macro _menu_escape
    (
        (= temp_str "NULL")
        (message "")
        (exit)
    )
)
(macro _menu_position
    (
        (int                _mnu_current_line
        )
        (inq_position _mnu_current_line NULL)
        (return _mnu_current_line)
    )
)
(macro _parse_child
    (
        (string            _dbf_file
                            _str_file
        )
        (get_parm 0 _dbf_file)
        (get_parm 1 _str_file)
        (if (== (substr _dbf_file 1 3) "..\\")
            (= _str_file (substr _dbf_file 4))
        ;else
            (if (== (substr _dbf_file 2 4) ":..\\")
                (= _str_file (substr _dbf_file 6))
            ;else
                (= _str_file _dbf_file)
            )
        )
        (while (index _str_file "\\")
            (= _str_file (substr _str_file (+ (index _str_file "\\") 1)))
        )
        (return _str_file)
    )
)