english version "1.0" # Copyright (c) 2006 by Wayne C. Gramlich # All rights reserved. module jog import character commands command_parse command_types expression float format gl glu glut in_stream integer logical ogls ogl_value out_stream steps string system table unsigned vector define options #: Command line options record file_names vector[string] #: File names to work with sequential_rapid logical #: -s trace logical #: -t trace_time logical #: -T no_connect logical #: -n scale string #: -S generate erase, allocate, print define jog #: Jog application record adjust_label label_tile #: adjust label a_entry entry_tile #: A Entry a_label label_tile #: A Label a_acceleration_entry entry_tile #: A acceleration a_backlash_entry entry_tile #: A backlash a_max_velocity_entry entry_tile #: A max velocity a_steps_per_unit_entry entry_tile#: A steps per unit a_direction_entry entry_tile #: A direction cnc_stream in_stream #: Current CNC input stream cnc_index unsigned #: Current CNC file index f_entry entry_tile #: F Entry f_label label_tile #: F Label file_names vector[string] #: .cnc files to process message_label label_tile #: Message label options options #: Command line options restart_button button_tile #: [Run] button run_button button_tile #: [Run] button skip_button button_tile #: [Skip] button steps steps #: {steps} object x_entry entry_tile #: X Entry x_label label_tile #: X Label x_acceleration_entry entry_tile #: X acceleration x_backlash_entry entry_tile #: X backlash x_max_velocity_entry entry_tile #: X max velocity x_steps_per_unit_entry entry_tile#: X steps per unit x_direction_entry entry_tile #: X direction y_entry entry_tile #: Y Entry y_label label_tile #: Y Label y_acceleration_entry entry_tile #: Y acceleration y_backlash_entry entry_tile #: Y backlash y_max_velocity_entry entry_tile #: Y max velocity y_steps_per_unit_entry entry_tile#: Y steps per unit y_direction_entry entry_tile #: Y direction z_entry entry_tile #: Z Entry z_label label_tile #: Z Label z_acceleration_entry entry_tile #: Z acceleration z_backlash_entry entry_tile #: Z backlash z_max_velocity_entry entry_tile #: Z max velocity z_steps_per_unit_entry entry_tile#: Z steps per unit z_direction_entry entry_tile #: Z direction generate erase, print # Main procedure: procedure main takes system system returns unsigned # Initialize GLUT and create window: system := standard@system() debug_stream :@= system.error_out_stream error_stream :@= system.error_out_stream jog :@= one_and_only@jog() command_parse :@= create@command_parse[options]("FunCAD") arguments_optional@(command_parse, '...', 'Files to read in', file_names_set@options) option_logical@(command_parse, "-n", 'Operate with no connection', no_connect_set@options) option_logical@(command_parse, "-T", 'Trace time operations', trace_time_set@options) option_logical@(command_parse, "-t", 'Trace G code operations', trace_set@options) option_logical@(command_parse, "-s", 'Axis sequential rapid operations', sequential_rapid_set@options) option_argument_optional@(command_parse, '-S ', 'Fraction to scale application by', scale_set@options) options :@= parse@(command_parse, system.arguments, error_stream, true, false) jog.options :@= options twenty_percent :@= float_convert@(".2") two :@= float_convert@(2) scale :@= float_convert@(1) if options.scale != "" scale :@= float_convert@(options.scale) if scale < twenty_percent scale := twenty_percent else_if scale > two scale := two application :@= create@application("FunCAD") minus_one :@= -integer_convert@(1) display_allocate@(application, "display0", "Jog", 800, 800, minus_one, minus_one, false, root_start_up, scale) events_process@(application) procedure root_start_up takes display display window window grid_tile grid_tile returns_nothing #: This code is invoked to initialize the root window {window} #, with its root grid tile of {grid_tile}. system :@= standard@system() debug_stream :@= system.error_out_stream error_stream :@= system.error_out_stream standard_in_stream :@= system.standard_in_stream # See about reading in any files from the command line: jog :@= one_and_only@jog() options :@= jog.options file_names :@= options.file_names size :@= file_names.size errors :@= 0 index :@= 0 loop while index < size file_name :@= file_names[index] #format@format2[unsigned, string](debug_stream, # "file_names[%d%]: %ds%\n\", index, file_name) file_name_size :@= file_name.size if file_name_size >= 4 && sub_string_equal@(file_name, file_name_size - 4, 4, ".cnc", 0, 4) cnc_stream :@= open_read@in_stream(file_name) if cnc_stream == ?? format@format1[string](error_stream, 'Could not open %ds% for reading\n\', file_name) errors :+= 1 else close@(cnc_stream) else format@format1[string](error_stream, '%ds% does not have a suffix of ".cnc" (or "-")\n\', file_name) errors :+= 1 index :+= 1 if errors != 0 exit@system(1) jog.file_names := file_names jog.cnc_index := 0 jog.cnc_stream := ?? steps :@= create@steps(??, ??, options.trace, false, false, !(options.no_connect), options.trace_time, false, false, options.sequential_rapid) jog.steps := steps # Process any configuration information: if size != 0 file_name :@= file_names[0] cnc_stream :@= open@in_stream(file_name) assert cnc_stream !== ?? #assert cnc_process@(steps, cnc_stream, true, false) !== ?? cnc_process@(steps, cnc_stream, true, false) #put@('Read in configuration information\n\', debug_stream) close@(cnc_stream) zero :@= float_convert@(0) ten_percent :@= float_convert@(".10") forty_percent :@= float_convert@(".40") one :@= float_convert@(1) seven :@= float_convert@(7) ten :@= float_convert@(10) # Set up the view control stuff: quaternion :@= create@quaternion() angle_axis_rotate@(quaternion, zero, zero, zero, one) x1_translate :@= variable@float_expression(zero) y1_translate :@= variable@float_expression(zero) z1_translate :@= variable@float_expression(zero) x2_translate :@= variable@float_expression(zero) y2_translate :@= variable@float_expression(zero) z2_translate :@= variable@float_expression(zero) view_grid_tile :@= grid_allocate@(grid_tile, "View") placement_mode@(view_grid_tile, 0, 1, 0, 1, false) xygrab1 :@= grab_allocate@(view_grid_tile, "xygrab1", x1_translate, y1_translate) xytilt :@= track_ball_allocate@(view_grid_tile, "xytilt", quaternion) xygrab2 :@= grab_allocate@(view_grid_tile, "xygrab2", x2_translate, y2_translate) placement_mode@(view_grid_tile, 0, 1, 1, 1, false) label_allocate@(view_grid_tile, "move1", "Move1", center, center, one) label_allocate@(view_grid_tile, "tilt", "Tilt", center, center, one) label_allocate@(view_grid_tile, "move", "Move2", center, center, one) placement_mode@(view_grid_tile, 0, 1, 2, 1, false) zoom1 :@= zoom_allocate@(view_grid_tile, "zoom1", z1_translate) zspin :@= spin_wheel_allocate@(view_grid_tile, "zspin", zero, zero, quaternion) zoom2 :@= zoom_allocate@(view_grid_tile, "zoom", z2_translate) # Set up the "button" entries: placement_mode@(grid_tile, 2, 1, 0, 1, true) buttons_grid_tile :@= grid_allocate@(grid_tile, "Parameters") entry_width :@= 10 placement_mode@(buttons_grid_tile, 0, 1, 0, 1, true) jog.x_label := label_allocate@(buttons_grid_tile, "x_label", "0", right, center, one) jog.y_label := label_allocate@(buttons_grid_tile, "y_label", "0", right, center, one) jog.z_label := label_allocate@(buttons_grid_tile, "z_label", "0", right, center, one) jog.a_label := label_allocate@(buttons_grid_tile, "a_label", "0", right, center, one) jog.f_label := label_allocate@(buttons_grid_tile, "f_label", "1", right, center, one) rapid_button :@= button_allocate@(buttons_grid_tile, "rapid", "Rapid", true, rapid_button@jog, "") cut_button :@= button_allocate@(buttons_grid_tile, "cut", "Cut", true, cut_button@jog, "") home_button :@= button_allocate@(buttons_grid_tile, "home", "Go Home", true, home_button@jog, "") origin_button :@= button_allocate@(buttons_grid_tile, "origin", "Origin Set", true, origin_button@jog, "") jog.restart_button :@= button_allocate@(buttons_grid_tile, "Restart", "Restart", true, restart_button@jog, "") jog.run_button :@= button_allocate@(buttons_grid_tile, "run", "Run", true, run_button@jog, "") jog.skip_button :@= button_allocate@(buttons_grid_tile, "skip", "Skip", true, skip_button@jog, "") jog.message_label :@= label_allocate@(buttons_grid_tile, "message", "Message", left, center, one) jog.message_label.tile.column_span := 5 placement_mode@(buttons_grid_tile, 1, 1, 0, 1, true) #x_text :@= label_allocate@(buttons_grid_tile, # "x", "X", left, center, one) jog.x_entry := entry_allocate@(buttons_grid_tile, "x_entry", "X", left, true, entry_width) jog.y_entry := entry_allocate@(buttons_grid_tile, "y_entry", "Y", left, true, entry_width) jog.z_entry := entry_allocate@(buttons_grid_tile, "z_entry", "Z", left, true, entry_width) jog.a_entry := entry_allocate@(buttons_grid_tile, "a_entry", "A", left, true, entry_width) jog.f_entry := entry_allocate@(buttons_grid_tile, "f_entry", "F", left, true, entry_width) value_replace@(jog.f_entry, "1") reset@jog("") placement_mode@(buttons_grid_tile, 2, 1, 0, 1, true) x_plus_button :@= button_allocate@(buttons_grid_tile, "x_plus", "X+", true, axis_adjust@jog, "x+") y_plus_button :@= button_allocate@(buttons_grid_tile, "y_plus", "Y+", true, axis_adjust@jog, "y+") z_plus_button :@= button_allocate@(buttons_grid_tile, "z_plus", "Z+", true, axis_adjust@jog, "z+") a_plus_button :@= button_allocate@(buttons_grid_tile, "a_plus", "A+", true, axis_adjust@jog, "a+") f_plus_button :@= button_allocate@(buttons_grid_tile, "f_plus", "F+", true, axis_adjust@jog, "f+") placement_mode@(buttons_grid_tile, 3, 1, 0, 1, true) x_minus_button :@= button_allocate@(buttons_grid_tile, "x_minus", "X-", true, axis_adjust@jog, "x-") y_minus_button :@= button_allocate@(buttons_grid_tile, "y_minus", "Y-", true, axis_adjust@jog, "y-") z_minus_button :@= button_allocate@(buttons_grid_tile, "z_minus", "Z-", true, axis_adjust@jog, "z-") a_minus_button :@= button_allocate@(buttons_grid_tile, "a_minus", "A-", true, axis_adjust@jog, "a-") f_minus_button :@= button_allocate@(buttons_grid_tile, "f_minus", "F-", true, axis_adjust@jog, "f-") placement_mode@(buttons_grid_tile, 4, 1, 0, 1, true) one_button :@= button_allocate@(buttons_grid_tile, "x_1_0", "x 1.0000", true, scale_adjust, "1") tenth_button :@= button_allocate@(buttons_grid_tile, "x_0_1", "x 0.1000", true, scale_adjust, ".1") hundredth_button :@= button_allocate@(buttons_grid_tile, "x_0_01", "x 0.0100", true, scale_adjust, ".01") thousandth_button :@= button_allocate@(buttons_grid_tile, "x_0_001", "x 0.0010", true, scale_adjust, ".001") ten_thousandth_button :@= button_allocate@(buttons_grid_tile, "x_0_0001", "x 0.0001", true, scale_adjust, ".0001") jog.adjust_label := label_allocate@(buttons_grid_tile, "adjust_label", "1", center, center, one) placement_mode@(buttons_grid_tile, 5, 1, 10, 1, true) empty_label :@= label_allocate@(buttons_grid_tile, "empty_label", "", center, center, one) buttons_rows :@= buttons_grid_tile.rows buttons_columns :@= buttons_grid_tile.columns buttons_rows[buttons_rows.size - 1].weight := one buttons_columns[buttons_columns.size - 1].weight := one # Set up the parameter entries: placement_mode@(grid_tile, 0, 1, 1, 1, true) axis_grid_tile :@= grid_allocate@(grid_tile, "Parameters") placement_mode@(axis_grid_tile, 0, 1, 0, 1, true) x_axis_text :@= label_allocate@(axis_grid_tile, "x_axis", "X Axis", center, center, one) jog.x_max_velocity_entry :@= entry_allocate@(axis_grid_tile, "x_max_velocity", "X Maximum Velocity", left, true, entry_width) jog.x_acceleration_entry :@= entry_allocate@(axis_grid_tile, "x_acceleration", "X Acceleration", left, true, entry_width) jog.x_backlash_entry :@= entry_allocate@(axis_grid_tile, "x_backlash", "X Backlash", left, true, entry_width) jog.x_steps_per_unit_entry :@= entry_allocate@(axis_grid_tile, "x_steps_per_unit", "X Steps/Unit", left, true, entry_width) jog.x_direction_entry :@= entry_allocate@(axis_grid_tile, "x_direction", "X Direction", left, true, entry_width) y_axis_text :@= label_allocate@(axis_grid_tile, "y_axis", "Y Axis", center, center, one) jog.y_max_velocity_entry :@= entry_allocate@(axis_grid_tile, "y_max_velocity", "Y Maximum Velocity", left, true, entry_width) jog.y_acceleration_entry :@= entry_allocate@(axis_grid_tile, "y_acceleration", "Y Acceleration", left, true, entry_width) jog.y_backlash_entry :@= entry_allocate@(axis_grid_tile, "y_backlash", "Y Backlash", left, true, entry_width) jog.y_steps_per_unit_entry :@= entry_allocate@(axis_grid_tile, "y_steps_per_unit", "Y Steps/Unit", left, true, entry_width) jog.y_direction_entry :@= entry_allocate@(axis_grid_tile, "y_direction", "Y Direction", left, true, entry_width) z_axis_text :@= label_allocate@(axis_grid_tile, "z_axis", "Z Axis", center, center, one) jog.z_max_velocity_entry :@= entry_allocate@(axis_grid_tile, "z_maz_velocity", "Z Maximum Velocity", left, true, entry_width) jog.z_acceleration_entry :@= entry_allocate@(axis_grid_tile, "z_acceleration", "Z Acceleration", left, true, entry_width) jog.z_backlash_entry :@= entry_allocate@(axis_grid_tile, "z_backlash", "Z Backlash", left, true, entry_width) jog.z_steps_per_unit_entry :@= entry_allocate@(axis_grid_tile, "z_steps_per_unit", "Z Steps/Unit", left, true, entry_width) jog.z_direction_entry :@= entry_allocate@(axis_grid_tile, "z_direction", "Z Direction", left, true, entry_width) a_axis_text :@= label_allocate@(axis_grid_tile, "a_axis", "A Axis", center, center, one) jog.a_max_velocity_entry :@= entry_allocate@(axis_grid_tile, "a_maa_velocity", "A Maximum Velocity", left, true, entry_width) jog.a_acceleration_entry :@= entry_allocate@(axis_grid_tile, "a_acceleration", "A Acceleration", left, true, entry_width) jog.a_backlash_entry :@= entry_allocate@(axis_grid_tile, "a_backlash", "A Backlash", left, true, entry_width) jog.a_steps_per_unit_entry :@= entry_allocate@(axis_grid_tile, "a_steps_per_unit", "A Steps/Unit", left, true, entry_width) jog.a_direction_entry :@= entry_allocate@(axis_grid_tile, "a_direction", "A Direction", left, true, entry_width) steps_extract@(jog) # Set up the display canvas: x_scale :@= constant@float_expression(ten) y_scale :@= x_scale z_scale :@= x_scale #placement_mode@(grid_tile, # 3, columns.size - 3, 3, rows.size - 3, false) placement_mode@(grid_tile, 1, 2, 1, 2, false) root_commands :@= create@commands() canvas :@= canvas_setup(grid_tile, "canvas", x1_translate / x_scale, y1_translate / y_scale, z1_translate / z_scale, xytilt, x2_translate / x_scale, y2_translate / y_scale, z2_translate / z_scale, root_commands) #funcad.root_commands := root_commands #funcad.canvas := canvas #format@format2[unsigned, unsigned](debug_stream, # "after canvas: columns.size=%d% rows.size=%d%\n\", # columns.size, rows.size) canvas_parent :@= canvas.tile redisplay_append@(xygrab1, canvas_parent) redisplay_append@(zoom1, canvas_parent) redisplay_append@(zspin, canvas_parent) redisplay_append@(xytilt, canvas_parent) redisplay_append@(xygrab2, canvas_parent) redisplay_append@(zoom2, canvas_parent) #format@format2[unsigned, unsigned](debug_stream, # "after redisplay: columns.size=%d% rows.size=%d%\n\", # columns.size, rows.size) rows :@= grid_tile.rows columns :@= grid_tile.columns grid_tile.columns[columns.size - 1].weight := one grid_tile.rows[rows.size - 1].weight := one procedure cut_button@jog takes callback_text string returns_nothing #: This procedure will cause the machine to go the specified location. system :@= standard@system() debug_stream :@= system.error_out_stream format@format1[string](debug_stream, "cut@jog(%ds%)\n\", callback_text) jog :@= one_and_only@jog() sixty :@= float_convert@(60) steps_update@(jog) x :@= float_convert@(jog.x_entry.value) y :@= float_convert@(jog.y_entry.value) z :@= float_convert@(jog.z_entry.value) f :@= float_convert@(jog.f_entry.value) format@format4[float, float, float, float](debug_stream, "Cut to x:%f% y:%f% z:%f% at feedrate f:%f%\n\", x, y, z, f) steps :@= jog.steps linear_cut@(steps, x, y, z, f / sixty, 0) flush@(steps, 0) memory_flush@(steps) steps_extract@(jog) rs274 :@= steps.rs274 rs274.x := x rs274.y := y rs274.z := z procedure home_button@jog takes callback_text string returns_nothing #: This procedure will cause the machine to go to the origin. system :@= standard@system() debug_stream :@= system.error_out_stream format@format1[string](debug_stream, "home_button@jog(%ds%)\n\", callback_text) jog :@= one_and_only@jog() steps_update@(jog) zero :@= float_convert@(0) steps :@= jog.steps rapid@(steps, zero, zero, zero, 0) flush@(steps, 0) memory_flush@(steps) steps_extract@(jog) rs274 :@= steps.rs274 #rs274.a := zero rs274.x := zero rs274.y := zero rs274.z := zero procedure origin_button@jog takes callback_text string returns_nothing #: This procedure will cause the machine to set the current location #, to the origin. system :@= standard@system() debug_stream :@= system.error_out_stream format@format1[string](debug_stream, "origin_button@jog(%ds%)\n\", callback_text) zero :@= float_convert@(0) izero :@= integer_convert@(0) jog :@= one_and_only@jog() steps :@= jog.steps steps.current := create@xpoint(zero, zero, zero) machine :@= steps.machine machine.a.step := izero machine.x.step := izero machine.y.step := izero machine.z.step := izero rs274 :@= steps.rs274 #rs274.a := zero rs274.x := zero rs274.y := zero rs274.z := zero steps_extract@(jog) procedure restart_button@jog takes callback_text string returns_nothing #: This procedure will run the .cnc program specified on the command line. system :@= standard@system() debug_stream :@= system.error_out_stream #put@("restart_button@jog()\n\", debug_stream) jog :@= one_and_only@jog() reset@jog("restart") procedure run_button@jog takes callback_text string returns_nothing #: This procedure will run the .cnc program specified on the command line. run_skip_button@jog(callback_text, false) procedure run_skip_button@jog takes callback_text string skip logical returns_nothing #: This procedure implement the run/skip buttons. system :@= standard@system() debug_stream :@= system.error_out_stream #format@format2[string, logical](debug_stream, # "run_skip_button@jog(%ds%, %l%)\n\", callback_text, skip) jog :@= one_and_only@jog() steps :@= jog.steps file_names :@= jog.file_names size :@= file_names.size index :@= jog.cnc_index loop while index < size cnc_stream :@= jog.cnc_stream if cnc_stream == ?? file_name :@= file_names[index] cnc_stream :@= open_read@in_stream(file_name) assert cnc_stream !== ?? jog.cnc_stream := cnc_stream jog.cnc_index := index message :@= cnc_process@(steps, cnc_stream, false, skip) #format@format1[string](debug_stream, # "Message: %ds%\n\", message) if message == ?? # We have just finished processed this .cnc file: close@(cnc_stream) jog.cnc_stream := ?? jog.cnc_index := index + 1 else # We have hit a pause condition: replace@(jog.message_label, message) break index :+= 1 if jog.cnc_index >= size replace@(jog.message_label, '(At end of files)') disable@(jog.run_button) disable@(jog.skip_button) else enable@(jog.run_button) enable@(jog.skip_button) enable@(jog.restart_button) if !skip flush@(steps, 0) memory_flush@(steps) steps_extract@(jog) procedure skip_button@jog takes callback_text string returns_nothing #: This procedure will skip over the next chunk of commands. run_skip_button@jog(callback_text, true) procedure rapid_button@jog takes callback_text string returns_nothing #: This procedure will cause the machine to go the specified location. system :@= standard@system() debug_stream :@= system.error_out_stream format@format1[string](debug_stream, "rapid@jog(%ds%)\n\", callback_text) jog :@= one_and_only@jog() steps_update@(jog) x :@= float_convert@(jog.x_entry.value) y :@= float_convert@(jog.y_entry.value) z :@= float_convert@(jog.z_entry.value) #format@format3[float, float, float](debug_stream, # "Move rapidly to x:%f% y:%f% z:%f%\n\", x, y, z) steps :@= jog.steps rapid@(steps, x, y, z, 0) flush@(steps, 0) memory_flush@(steps) steps_extract@(jog) rs274 :@= steps.rs274 rs274.x := x rs274.y := y rs274.z := z procedure reset@jog takes callback_text string returns_nothing #: This procedure will reset the coordinates to the origin. jog :@= one_and_only@jog() value_replace@(jog.a_entry, "0") value_replace@(jog.x_entry, "0") value_replace@(jog.y_entry, "0") value_replace@(jog.z_entry, "0") cnc_stream :@= jog.cnc_stream if cnc_stream !== ?? close@(cnc_stream) jog.cnc_stream := ?? jog.cnc_index := 0 replace@(jog.message_label, "(At Beginning of Files)") disable@(jog.restart_button) enable@(jog.run_button) enable@(jog.skip_button) procedure axis_adjust@jog takes callback_text string returns_nothing #: This procedure will adjust the axis specified in {jog}. system :@= standard@system() debug_stream :@= system.error_out_stream jog :@= one_and_only@jog() #format@format1[string](debug_stream, # "axis_adjust@jog(%ds%) called\n\", callback_text) axis :@= callback_text[0] entry:: entry_tile := ?? if axis = "a"[0] entry := jog.a_entry else_if axis = "x"[0] entry := jog.x_entry else_if axis = "y"[0] entry := jog.y_entry else_if axis = "z"[0] entry := jog.z_entry else_if axis = "f"[0] entry := jog.f_entry else assert false value :@= float_convert@(entry.value) adjust :@= float_convert@(jog.adjust_label.text) if callback_text[1] = "+"[0] value :+= adjust else value :-= adjust value_replace@(entry, string_convert@(value)) procedure steps_extract@jog takes jog jog returns_nothing #: This procedure will extract the configuration information #, from {steps} and shove it into {jog}. machine :@= jog.steps.machine axis_extract@jog(machine.a, jog.a_label, jog.a_acceleration_entry, jog.a_backlash_entry, jog.a_max_velocity_entry, jog.a_steps_per_unit_entry, jog.a_direction_entry) axis_extract@jog(machine.x, jog.x_label, jog.x_acceleration_entry, jog.x_backlash_entry, jog.x_max_velocity_entry, jog.x_steps_per_unit_entry, jog.x_direction_entry) axis_extract@jog(machine.y, jog.y_label, jog.y_acceleration_entry, jog.y_backlash_entry, jog.y_max_velocity_entry, jog.y_steps_per_unit_entry, jog.y_direction_entry) axis_extract@jog(machine.z, jog.z_label, jog.z_acceleration_entry, jog.z_backlash_entry, jog.z_max_velocity_entry, jog.z_steps_per_unit_entry, jog.z_direction_entry) procedure position_extract@jog takes label label_tile value float returns_nothing #: This procedure will update {label} with {value}. replace@(label, string_convert@(value)) procedure steps_update@jog takes jog jog returns_nothing #: This procedure will take the information out of {jog} and #, place it back into {jog}.{steps}. steps :@= jog.steps machine :@= steps.machine axis_update@jog(machine.a, jog.a_acceleration_entry, jog.a_backlash_entry, jog.a_max_velocity_entry, jog.a_steps_per_unit_entry, jog.a_direction_entry) axis_update@jog(machine.x, jog.x_acceleration_entry, jog.x_backlash_entry, jog.x_max_velocity_entry, jog.x_steps_per_unit_entry, jog.x_direction_entry) axis_update@jog(machine.y, jog.y_acceleration_entry, jog.y_backlash_entry, jog.y_max_velocity_entry, jog.y_steps_per_unit_entry, jog.y_direction_entry) axis_update@jog(machine.z, jog.z_acceleration_entry, jog.z_backlash_entry, jog.z_max_velocity_entry, jog.z_steps_per_unit_entry, jog.z_direction_entry) axis_update@(steps) procedure axis_extract@jog takes axis axis label label_tile acceleration entry_tile backlash entry_tile max_velocity entry_tile steps_per_unit entry_tile direction entry_tile returns_nothing #: This procedure will extract the information from {axis} and stuff #, it into {acceleration_entry}, {backlash_entry}, and #, {max_velocity_entry}. system :@= standard@system() debug_stream :@= system.error_out_stream #put@("=>axis_extract@jog()\n\", debug_stream) zero :@= float_convert@(0) ten :@= float_convert@(10) sixty :@= float_convert@(60) axis_steps_per_unit :@= float_convert@(axis.steps_per_unit) buffer :@= allocate@string() position :@= float_convert@(axis.step) / axis_steps_per_unit if position >= zero buffer_append@("+", buffer) else buffer_append@("-", buffer) position := -position if position < ten * axis_steps_per_unit buffer_append@("0", buffer) sposition :@= string_convert@(position) buffer_append@(sposition, buffer) if sposition.size <= 1 buffer_append@(".", buffer) loop while buffer.size < 10 buffer_append@("0", buffer) trim@(buffer, 10) replace@(label, buffer) value_replace@(acceleration, string_convert@(axis.maximum_acceleration)) value_replace@(backlash, string_convert@(axis.backlash)) value_replace@(max_velocity, string_convert@(axis.maximum_velocity * sixty)) value_replace@(steps_per_unit, string_convert@(axis.steps_per_unit)) dir :@= "0" if axis.direction dir :@= "1" value_replace@(direction, dir) #format@format2[string, logical](debug_stream, # "axis_extract@jog(): %s%_axis.direction=%l%\n\", # axis.label, axis.direction) #put@("<=axis_extract@jog()\n\", debug_stream) procedure axis_update@jog takes axis axis acceleration_entry entry_tile backlash_entry entry_tile max_velocity_entry entry_tile steps_per_unit_entry entry_tile direction_entry entry_tile returns_nothing #: This procedure will update the information in {axis} and from #, {acceleration_entry}, {backlash_entry}, and {max_velocity_entry}. #system :@= standard@system() #debug_stream :@= system.error_out_stream sixty :@= float_convert@(60) axis.maximum_acceleration := float_convert@(acceleration_entry.value) axis.backlash := float_convert@(backlash_entry.value) axis.maximum_velocity := float_convert@(max_velocity_entry.value) / sixty axis.steps_per_unit := unsigned_convert@(steps_per_unit_entry.value) axis.direction := unsigned_convert@(direction_entry.value) != 0 #format@format2[string, logical](debug_stream, # "axis_update@jog(): %s%_axis.direction=%l%\n\", # axis.label, axis.direction) procedure scale_adjust takes callback_text string returns_nothing #: ... system :@= standard@system() debug_stream :@= system.error_out_stream format@format1[string](debug_stream, "scale_adjust(%ds%) called\n\", callback_text) jog :@= one_and_only@jog() replace@(jog.adjust_label, callback_text) procedure canvas_setup takes grid grid_tile name string x1_translate float_expression y1_translate float_expression z1_translate float_expression track1 track_ball_tile x2_translate float_expression y2_translate float_expression z2_translate float_expression root_commands commands returns canvas_tile #: This procedure will create a top level window for {display} #, containing some visually interesting stuff. system :@= standard@system() debug_stream :@= system.error_out_stream zero :@= float_convert@(0) half_percent :@= float_convert@(".005") one_percent :@= float_convert@(".01") two_percent :@= float_convert@(".02") five_percent :@= float_convert@(".05") eight_percent :@= float_convert@(".08") ten_percent :@= float_convert@(".10") thirty_percent :@= float_convert@(".30") sixty_percent :@= float_convert@(".60") ninty_percent :@= float_convert@(".90") one :@= float_convert@(1) two :@= float_convert@(2) three :@= float_convert@(3) four :@= float_convert@(4) five :@= float_convert@(5) seven :@= float_convert@(7) fifteen :@= float_convert@(15) thirty :@= float_convert@(30) minus_one :@= -one minus_two :@= -two xeight_percent :@= constant@float_expression(eight_percent) xten_percent :@= constant@float_expression(ten_percent) xthirty_percent :@= constant@float_expression(thirty_percent) xsixty_percent :@= constant@float_expression(sixty_percent) xone :@= constant@float_expression(one) xzero :@= constant@float_expression(zero) xfifteen :@= constant@float_expression(fifteen) # The new stuff: #window :@= window_append@(display, "main", # left_fraction, ten_percent, thirty_percent, one, # value@glut_values(rgb) | # value@glut_values(double) | value@glut_values(depth)) canvas :@= canvas_allocate@(grid, name) # Do resize commands: resize_commands :@= canvas.resize resize_width :@= canvas.width resize_height :@= canvas.height izero :@= constant@integer_expression(integer_convert@(0)) xy_aspect :@= float_convert@(resize_width) / float_convert@(resize_height) #xviewport@(resize_commands, izero, izero, resize_width, resize_height) xmatrix_mode@(resize_commands, gl_constant@integer_expression(projection)) load_identity@(resize_commands) xfrustum@(resize_commands, -xy_aspect * xeight_percent, xy_aspect * xeight_percent, -xeight_percent, xeight_percent, xten_percent, xfifteen) # Do initialization commands: initial_commands :@= canvas.initial # Set up lights: xenable@(initial_commands, gl_constant@integer_expression(lighting)) xlite0 :@= gl_constant@integer_expression(light0) xenable@(initial_commands, xlite0) xlight@(initial_commands, xlite0, gl_constant@integer_expression(ambient), xten_percent, xten_percent, xthirty_percent, xone) xlight@(initial_commands, xlite0, gl_constant@integer_expression(diffuse), xsixty_percent, xsixty_percent, xone, xone) xlight@(initial_commands, xlite0, gl_constant@integer_expression(position), xone, xone, xone, xzero) # Enable z-buffering: xenable@(initial_commands, gl_constant@integer_expression(depth_test)) # Now provide the redisplay stuff: prefix_commands :@= create@commands() clear_color@(prefix_commands, ninty_percent, ninty_percent, ninty_percent, one) xclear@(prefix_commands, gl_constant@integer_expression(color_buffer_bit) | gl_constant@integer_expression(depth_buffer_bit)) xmatrix_mode@(prefix_commands, gl_constant@integer_expression(modelview)) load_identity@(prefix_commands) translate@(prefix_commands, zero, zero, -seven) xtranslate@(prefix_commands, x2_translate, y2_translate, z2_translate) quaternion_rotate@(prefix_commands, track1.quaternion_current) color@(prefix_commands, zero, one, zero, one) xbegin@(prefix_commands, gl_constant@integer_expression(lines)) vertex@(prefix_commands, zero, zero, zero) vertex@(prefix_commands, fifteen, zero, zero) vertex@(prefix_commands, zero, zero, zero) vertex@(prefix_commands, zero, fifteen, zero) vertex@(prefix_commands, zero, zero, zero) vertex@(prefix_commands, zero, zero, fifteen) end@(prefix_commands) xtranslate@(prefix_commands, x1_translate, y1_translate, z1_translate) #translatef@gl(dx, dy, -dz) xenable@(prefix_commands, gl_constant@integer_expression(cull_face)) #FIXME: Shouldn't we be front only!!! xpolygon_mode@(prefix_commands, gl_constant@integer_expression(front_and_back), gl_constant@integer_expression(fill)) xcull_face@(prefix_commands, gl_constant@integer_expression(back)) xfront_face@(prefix_commands, gl_constant@integer_expression(ccw)) xenable@(prefix_commands, gl_constant@integer_expression(color_material)) xpolygon_mode@(prefix_commands, gl_constant@integer_expression(front), gl_constant@integer_expression(ambient_and_diffuse)) color@(prefix_commands, zero, zero, zero, one) xbegin@(prefix_commands, gl_constant@integer_expression(lines)) vertex@(prefix_commands, zero, zero, zero) vertex@(prefix_commands, fifteen, zero, zero) vertex@(prefix_commands, zero, zero, zero) vertex@(prefix_commands, zero, fifteen, zero) vertex@(prefix_commands, zero, zero, zero) vertex@(prefix_commands, zero, zero, fifteen) end@(prefix_commands) # Notice that {root_commands} is being inserted at index 1: display_commands :@= canvas.display sub_command@(display_commands, prefix_commands) sub_command@(display_commands, root_commands) swap_buffers@(display_commands) #show@(prefix_commands, 0, 10, 1, debug_stream) return canvas procedure one_and_only@jog takes_nothing returns jog #: This procedure will return the one and only {jog} object. return ??