Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
11716 lines (9947 sloc) 302 KB
'---- Security was removed for Open Source!
'---- Added parameter settings for normally open or closed limit switches
'---- Added "E" for Extruder use in 3d printer and added ";" as comment designator to simulate reprap printer.
'---- Fixed a problem reading multi line instructions that could cause lockup.
'---- Changed direction of work offest shift setting and letter to "S" for shift
'---- Added preset and add to the work offsets.
'---- Added aceleration and deceleration to machine home routine! (homeadd:)
'---- Added backlash delay timer tmr6??
'---- Fixed problem with expanded memory array, was crashing on 4 million line files.
'---- Stopped the watchdog timer shutdown in emgstop: and the home pos flags!
'---- Added save options to edit mode to save time when using large files
'---- Super_array was added to increase file size to over 7 million lines!
'---- Added block search to file edit menu
'---- Fixed the problem with pulse hande dropout on some chipsets!
'---- Changed work cooridinate offsets to remain after reset!
'---- Changed rapid from independant axis to linear rapid move!
'---- Added GS2 register reading and setting from control
'---- Added key filter for num-lock and cap-lock keys
'---- Fixed on the fly axis mirroring (was delayed)
'---- Changed cool2 in menu to read AUX-1
'---- Fixed the axis mirror failure when on G18 and G19 planes.
'---- Added extra handle parameter to soften large handle steps
'---- Added extra parameter to get handle to work with odd pitched ball screws
'---- Changed (handadd:) accel/decel on handle input so it's smoother in large steps
'---- Started --- LATHE ---- mods
'---- Fixed "A" axis feed rate multiplier prompt to display correct prompt.
'---- Added port read on E-stop "error_port%" and display the number read.
'---- Added save to tool and offset pages with "U" key
'---- Remarked out from upd_pos: routine the Lval% lines for digitizing in subs.
'---- Fixed the point save routine so points can be saved again.
'---- Attempted to fix E-stop so it don't false trigger and pause machine
'---- Fixed program hangup from operation without any feed rate set
'---- Increased the rotary port multiplier to hold larger number up to 999.
'---- Added custom port address settings
'---- Added password to enable access to the parameter setup screens
'---- Fixed the rtc interrupt routine by doing a second read to reset the chip interrupt
'---- Re-worked canned cycles, added delay to fix G31 (skip cut) and G92
'---- Fixed M00 & M01 to stop before reading next line
'---- Fixed corner dedeleration to work on all planes
'---- Re-fixed the E-stop problem
'---- finally fixed the RESET problem of next line running after reset
'---- still some nicks in the manual feed setting while changing speed
'---- limit switches can now be configured seperately for each axis
'---- increased axis step size limit of 32767 to 65535
'---- Reworked execution order, need to check ALL COMMANDS IN ALL ORDERS!
'---- Auto corner feed appears to be working! need to do full test!
'---- constant feed control working with one line look ahead
'---- mb
'---- added PWM option for spindle RPM control for the cheepie peepies
'---- added EMERGENCY STOP sub for E-stop shutdown control
'---- fixed the backlash problem again caused from the independant step fix
'---- added wfct! to re-scale A axis to acheive higher feed rate ratios
'---- added check to prevent MDI mode working when on axis limit
'---- added independant axis step counts per-unit
'---- corrected the step loss on tiny arcs through quadrants
'---- fixed G21 metric command to operate on the fly
'---- changed the rotary axis divider to same value as other axes to fix
' rotation error problem on the A axis.
'----changed A and Z axes to follow feed rate even with diff steps per inch
'--- added a timer to the cmos clock interrupt to time RPM on the spindle
'--- fixed the problem with calling canned cycles in sub causing cycle run on call line
'--- feed would not inc, if keypad + key used and was fixed.
'--- fixed high speed wrap around on the output routine that caused position error
'--- fixed the wrong direction R calculation on G2/G3 commands in the G19/G18 planes,still marked "atest"just in case!
'--- fixed a problem with cutter comps on the G18 and G19 planes. marked lines with "atest" for searching
'--- fixed the string conversion problem that would cause a hang after zillion lines.
'--- fixed the "/" to skip the remaining line of G-gode
'--- fixed G21 & G20 problem of switching back and forth while running
'--- increased Nval& to long for larger line numbers
'--- adding M50 code to syncronize a program move to an external event
'--- added accel/decl to handle movements, cli and sti instructions around handx& inc and dec comands to stop handwheel count loss
'--- changed the Line repeat counter to display the previous subs L value if the current L is 0
'--- fixed the anoying flicker on the corner clock display
'--- increased the calculated feed rate maximum to be faster
'--- corrected the handle interrupt resetting to original address problem
'--- fixed the axis zero setting when axis mirror is on
'--- fixed a problem with G83 in metric mode(Q value was not converted by metric!)
'--- fixed the backlash problem effecting single step moves
'--- problem!!!! backlash is always on the g17 plane, may not be working
'--- correctly in G18 or G19, may be on wrong axis ??? don't know
'--- fixed totally a problem with jog and handle missing first pulse from no setup time
'--- removing light option from front control and replace with cool2
'--- rename the aux outputs on port2 to s1,s2,s3 and 4096hz status
'-----------------
$COM 512
sig$="2016-Open"
ver$="CNC ZEUS v1.91.2"
%USE_EMS=1 '1 = compile to use ems memory, 0 = no ems
ON ERROR GOTO ETRAP
plug$=" www.cnczeus.com"
flen1? = ascii(left$(sig$,1))
FLEXCHR$=chr$(0)
%line_length = 38
'--------------------------------------------------------
type movedat
FLine as string * 124
Dval as integer
Fval as single
Hval as integer
Nval as long
Lval as integer
Rval as long
Sval as single
Tval as integer
Qval as long
Canz as long
Oval as integer
Pval as integer
mg0 as integer
mg1 as integer
mg2 as integer
mg3 as integer
mg4 as integer
skp as integer
g0 as integer
g1 as integer
g2 as integer
g3 as integer
g6 as integer
g7 as integer
g8 as integer
g9 as integer
g10 as integer
g14 as integer
x92 as long
y92 as long
z92 as long
w92 as long
xcmd as long
ycmd as long
zcmd as long
wcmd as long
xdist as long
ydist as long
zdist as long
wdist as long
xpos as long
ypos as long
zpos as long
wpos as long
Ival as long
Jval as long
Kval as long
Xcp as long
Ycp as long
fvx1 as single
fvy1 as single
fvz1 as single
fvw1 as single
fvx2 as single
fvy2 as single
fvz2 as single
fvw2 as single
offx1 as long
offy1 as long
offx2 as long
offy2 as long
offI as long
offJ as long
Roff as long
cdist as long
hx as long
hy as long
hz as long
lnum as long
look as integer
new as integer
rpd as integer
Sublevel as integer
hold_next as integer
candelay as integer
mirrx as integer
mirry as integer
end type
type disp_box
x as byte
y as byte
h as byte
v as byte
cf as byte
cb as byte
hf as byte
hb as byte
bdr as byte
end type
type work_offset
x as long
y as long
z as long
w as long
end type
'---------------------------- Program line buffer --------
'------Test for EMS memory and create array of 100 lines or fail! -----
if fre(-11) > 0 then er$=super_array$(1,100,"") else fail$="NEED EMS MEMORY TO OPERATE!": goto exitg
'$IF %USE_EMS
'if fre(-11) > 0 then dim virtual lbuf (100) as string * %line_length else fail$="NEED EMS MEMORY TO OPERATE!": goto exitg
'$ELSE
'dim lbuf (100) as string * %line_length
'$ENDIF
gosub setpal
'--------------------------------------
dim hipseg as word
dim hipptr as word
dim hip1 as word
dim hip2 as word
dim p1 as byte ptr
dim p4 as word ptr
hipseg = codeseg(handsub)
hipptr = codeptr(handsub)
dim mdat(4) as movedat
dim dseg as word ptr
dim keyseg as word ptr
dim rtimer as word ptr
dim dosclk as dword ptr
dim jpdos as dword ptr
dim cseg1 as word
dim cseg2 as word
dim ipseg as word
dim ipptr as word
dim ip1 as word
dim ip2 as word
dim wrk(6) as work_offset
dim ktx?(128)
dim sublptr&(11)
dim hlp$(4)
'dim nnum$(20)
'dim blk$(20)
inrtc?=0 'in service rt_int interrupt counter DO NOT USE
lrtc2?=0 'current divide by 8 counter counts 0-8 use NO
kt1?? = varseg (ktx?(1))
kt2?? = varptr (ktx?(1))
tmr1??=0 'general purpose timer for delay times 1khz
tmr2??=0 'canned cycle timer for "P" delay time 1khz
tmr3??=0 'rpm counter do not use any tmr3 stuff for GP use 8192 HZ
tmr4??=0 'rpm averaging counter,do not use
tmr5??=0 'added for G04 delay timer
tmr6??=0 'backlash delay timer
tmr3low??=0 'low if limitw pin is low
rpmcntr??=0 'last rpm count at 8192 HZ
revcnt??=0 'spindle rotation counter, increments each rotation
watchdog?=1 'enable watchdog timer output
pwm?=0 '0=disable PWM output for spindle drive. 1=enable pwm
pwmcount%=0 'incrementing up count for pwm
pwmpos%=0 'current pwm value (set from S command) 818= 50% RPM
pwmmax%=1637 'rollover count or full on value for pwm counter
pwmrpm%=1000 ' full motor RPM at max PWM
pwmphase?=0 'current output phase of 5hz pwm
comtmr1??=0 'com port timer
mult%=100
dseg = codeptr32(p)
@dseg= varseg(mult%)
keyseg = codeptr32(kak)
@keyseg = varseg(mult%)
rtimer = codeptr32(rtc)
@rtimer = varseg(mult%)
'------------------------pointers to handle isr -----
p1 = codeptr32(hy)
p4 = codeptr32(hp)
@p4 = varseg(multi%)
dim jp_loc_ptr as dword ptr
'--------------------------------------xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx------
pi1# = 1.57079632679 '--- pi/2
tg# = 57.2957795130823 '--- to convert radians to degrees
pi# = 3.141592653589795 '--- pi
f3?=200:f4?=200
os%=0
gb%(os%)=0
'---------------------- display box locations and sizes ----------------
'--------------- background colors ----- see setdefaultcolor
'--------------- title bar colors --- see setdefaultcolor
'----------- F key select menu colors ------- see setdefaultcolor
dim w1 as disp_box '----- position window ------
w1.x=47
w1.y=2
w1.h=15
w1.v=5
w1.cf=12
w1.cb=2
w1.bdr=7
dim w2 as disp_box '----- distance to go window -------
w2.x=64
w2.y=2
w2.h=15
w2.v=5
w2.cf=3
w2.cb=2
w2.bdr=7
dim w3 as disp_box '---- run file window ------
w3.x=3
w3.y=3
w3.h=40
w3.v=15
w3.cf=0
w3.cb=2
w3.hf=15
w3.hb=7
w3.bdr=8
dim w4 as disp_box '---- TOOL window ------
w4.x=47
w4.y=8
w4.h=16
w4.v=8
w4.cf=3
w4.cb=2
w4.bdr=7
dim w5 as disp_box '---- G code window ------
w5.x=73 '75
w5.y=9 '2
w5.h=6
w5.v=12 '11
w5.cf=0
w5.cb=5
w5.bdr=8
dim w6 as disp_box '---- MSG window ------
w6.x=2
w6.y=20
w6.h=43
w6.v=3
w6.cf=0
w6.cb=5
w6.bdr=8
dim w7 as disp_box '---- directory window ------
w7.x=2
w7.y=3
w7.h=77
w7.v=17 '18
w7.cf=0
w7.cb=5
w7.hf=13
w7.hb=2
w7.bdr=8
dim w8 as disp_box '---- tool D/H offset table window ------
w8.x=5
w8.y=2
w8.h=41
w8.v=21
w8.cf=0
w8.cb=11
w8.hf=7
w8.hb=2
w8.bdr=8
dim w9 as disp_box '---- tool length input window ------
w9.x=47
w9.y=14
w9.h=25
w9.v=2
w9.cf=0
w9.cb=5
w9.bdr=0
dim w10 as disp_box '---- PARAMETER window COLORS ------
w10.x=4
w10.y=6
w10.h=70
w10.v=16
w10.cf=0
w10.cb=11
w10.hf=7
w10.hb=2
w10.bdr=0
dim w11 as disp_box '---- WORK OFFSET text input window ------
w11.x=62
w11.y=17
w11.h=16
w11.v=2
w11.cf=0
w11.cb=7
w11.bdr=7
dim w12 as disp_box '---- WORK abs position window ------
w12.x=62
w12.y=3
w12.h=15
w12.v=5
w12.cf=12
w12.cb=2
w12.bdr=7
dim w13 as disp_box '---- WORK machine position window ------
w13.x=62
w13.y=10
w13.h=15
w13.v=5
w13.cf=12
w13.cb=2
w13.bdr=7
dim w14 as disp_box '---- WORK OFFSET table window ------
w14.x=2
w14.y=3
w14.h=70
w14.v=16
w14.cf=0
w14.cb=11
w14.hf=7
w14.hb=2
w14.bdr=0
dim w15 as disp_box '---- SETUP window ------
w15.x=4
w15.y=2
w15.h=70
w15.v=10
w15.cf=0
w15.cb=5
w15.hf=7
w15.hb=2
w15.bdr=0
dim w16 as disp_box '---- AXIS HOME window ------
w16.x=28
w16.y=11
w16.h=19
w16.v=7
w16.cf=12
w16.cb=2
dim w17 as disp_box '---- M code window ------
w17.x=65
w17.y=9
w17.h=6
w17.v=7
w17.cf=0
w17.cb=5
w17.bdr=8
dim w18 as disp_box '---- GS2 drive spindle Load window ------
w18.x=47
w18.y=18
w18.h=24
w18.v=3
w18.cf=0
w18.cb=5
w18.bdr=8
dim w19 as disp_box '---- command window ------
w19.x=47
w19.y=18
w19.h=24
w19.v=5
w19.cf=0
w19.cb=5
w19.bdr=8
dim w20 as disp_box '---- mach position display window ------
w20.x=64
w20.y=2
w20.h=15
w20.v=5
w20.cf=3
w20.cb=2
w20.bdr=7
dim w21 as disp_box '---- tool abs position window ------
w21.x=47
w21.y=2
w21.h=15
w21.v=5
w21.cf=3
w21.cb=2
w21.bdr=7
dim w22 as disp_box '---- tool mach position window ------
w22.x=64
w22.y=2
w22.h=15
w22.v=5
w22.cf=3
w22.cb=2
w22.bdr=7
dim w23 as disp_box '---- tool command window ------
w23.x=47
w23.y=18
w23.h=24
w23.v=5
w23.cf=0
w23.cb=5
w23.bdr=8
dim lastmdi$(20)
txth%=40:txtv%=4
txth1%=30:txtv1%=6
'-----------------------------------------------------------------------
dataport% = &h378 '--- port address
statusport% = dataport%+1
controlport% = dataport%+2
xdirbit?=0:xstepbit?=1 'port step and dir bits
ydirbit?=2:ystepbit?=3
zdirbit?=4:zstepbit?=5
wdirbit?=6:wstepbit?=7
xlowhi%=0:ylowhi%=0:zlowhi%=0:wlowhi%=0
xlimpin?=15
ylimpin?=13
zlimpin?=12
wlimpin?=10
holdpin?=11
xlimbit? =3
ylimbit? =4
zlimbit? =5
wlimbit? =6
holdbit? =7
limx_no%=0
limy_no%=0
limz_no%=0
limw_no%=0
estp_no%=0
sfwdpin?=1
srevpin?=14
coolpin?=16
coolpin2?=17
'litpin?=17
sfwdbit? =0
srevbit? =1
coolbit? =2
coolbit2?=3
'litbit? =3
'----------------- set aux port pins
dataport2% = &h278 '--- port address
statusport2% = dataport2%+1
controlport2% = dataport2%+2
handirq% = 5
h1pulse% = 8 : h1step% = 1
h10pulse% = 4 : h10step% = 5
h100pulse% = 4 : h100step% = 50
fbits?=&h0f
auxio5?=&h10
auxio6?=&h20
hdlbits?=&hc0
auxin1? =&h08
handain?=&h10
handbin?=&h20
handint?=&h40
auxin2? =&h80
aux1pin?=1
aux2pin?=14
aux3pin?=16
aux4pin?=17
aux1bit?=0
aux2bit?=1
aux3bit?=2
aux4bit?=3
'------------------------ COMPORT SETTINGS FOR GS2 AC SPINDLE DRIVE
gsdrive%=0
spndlon$="0106091B0001D4"
spndloff$="0106091B0000D5"
spndlfwd$="0106091C0000D4"
spndlrev$="0106091C0001D3"
comport1$="COM1"
baud1$="38400"
parity1$="N"
databits1$="7"
stopbit1$="2"
comdelay%=20
freqmin!=1.5
freqmax!=60
maxsovr%=120
minsovr%=50
rpminc%=10
maxs!=9999.9
spndelay?? = 500
spcnt% = 100
motor% = 1725
freqbase!=60
gearcount? = 8
pram_dec$="0000"
pram_dat$="0000"
dim ratio!(gearcount?)
ratio!(1)=.1133
ratio!(2)=.1615
ratio!(3)=.2408
ratio!(4)=.3456
ratio!(5)=.5552
ratio!(6)=.7875
ratio!(7)=1.2068
ratio!(8)=1.7054
softlim%=0
limxhi& = 1000:limxlo& = -10000
limyhi& = 1000:limylo& = -10000
limzhi& = 1000:limzlo& = -10000
limwhi& = 1000:limwlo& = -10000
extpercent?=0
'feedconst!=.0015 '-- max feed calculator constant, smaller allows faster clks
feedconst!=.0013 '-- max feed calculator constant, smaller allows faster clks
feedmult%=10 '---- 10=100% feedrate ------
feedinc!=1
maxfeed!=20 '--- max feed rate, G0
rpd1!=1 '--- set inital rapid override at 100%
fpd1!=1 '--- set inital feed override at 100%
accl! = 2 '--- acceleration and deceleration in inch/per second
extfin?=1 '--- must be one if external feed control is not used
lastrin?=4 '--- last rapid multiplier read from external control
lastfin?=10 '--- last feed multiplier read from external control
acelg0%=1 '--- accel/decel on G0 moves only if "1"
corner_gain!=1 '--- multiplier for corner deceleration; 2 = 2x slower
makefeed%=0 '--- when set to one causes external feed override of zero to keep moving
revx%=0 '--- inverts the axis counting direction only +/-
revy%=1 '--- use for direction setup only not to mirror
revz%=0
revw%=0
'-------------------- MIRROR by data "multiply data by -1"
mirrx%=1 '--- mirror x axis when -1 , use this to mirror axis x
mirry%=1 '--- mirror y axis when -1 , use this to mirror axis y
mir_x% = mirrx% '--- sets mir_x the same as mirrx so the display is correct
mir_y% = mirry%
mode$=" MODE "
auto%=10 '--- set auto run to off
gp3%=90 '--- default absolute mode = G90
gp2%=17 '--- default plane x/y = G17
gp7%=40 '--- default offset mode = G40
gp9%=80 '--- default canned cycle = 80
gp6%=20 '--- default inch input = 20
gp8%=49 '--- default tool length = 49 cancel
gp10%=98 '--- default return point = 98 inital start point
gp14%=54 '--- default work cooridinate = 54
lastplane%=gp2%
'-------------------------------------------------
bcklshx%=1 '--- axis backlash compensation
bcklshy%=1
bcklshz%=1
bcklshw%=1
xyscale# = 1.
zscale# = 1.
wscale# = 1.
metric! = 1.
handcount&=0
handadder%=100
handcarry%=100
handsoft%=1
rotarya%=0 '---- 1 = rotary axis for A
'---- steps per inch -----------------
spix?? = 2000
spiy?? = 2000
spiz?? = 2000
spiw?? = 2000
spi?? = max (spix??,spiy??,spiz??,spiw??)
dvspi&=spi??*100
dvspix&=spix??*100
dvspiy&=spiy??*100
dvspiz&=spiz??*100
dvspiw&=spiw??*100
dvdrx&=0
dvdry&=0
dvdrz&=0
dvdrw&=0
wfct!=1.0000 '--- sets default W axis factor to 1 (same as other axes)
errtol% = 200 '--- error tolerance for tool path calculations = 200 --
'--- this is in expanded units and is about = to dv! --
expand& = 100000 '-- multiplier to improve acuracy -----?
dv! = expand& / spi??
expandw& = expand&
dvw!=dv!
rolla%=360
'Wmax&=rolla% * expandw&
'rolldspa&= rolla% * spi??/wfct!
zerox%=0
zeroy%=0
zeroz%=0
zerow%=0
limclear% = 200
homefeed1! = 30
feed1! = 10 '---- set initial feed rate so files load faster
retratio% = 30
dirhomex%=1
dirhomey%=1
dirhomez%=1
extfeed%=0 '--- 1 enables external feed control
exthand%=0 '--- 1 enables manual pulse generator
srevtime?? = 1000
pram28% = 20 '-- sets distance to move from limits on zero return, in steps
pram83% = 20 '-- sets rapid in hole stop short distance! in steps
menu%=1
doit%=0
filename$="NEW.NC"
dirname$=curdir$
if right$(dirname$,1) <>"\" then
dirname$=dirname$+"\"
end if
password$="zeus"
passkey$=password$
datafile$="NEWDATA.NC"
savename$="TOOL.CFG"
dfext$ =".NC"
maxtools%=100
toolpage%=0
toolptr%=0
helpbit%=1
dim mcode%(6)
dim doffset#(maxtools%):dim hoffset&(maxtools%)
if pbvCpu <3 then fail$="CPU must be at least 486 or better": goto exitg
gosub setdefaultcolor
'----------- READ THE LAST CONFIG FILE !!!!!!!!!!!!!!!!!!!!!!!!!
50 f$=dir$ (savename$)
if f$ = savename$ then gosub getall '--- read config file if exists ---!
'-------- Things that need to be set after reading config file ----!!!!
'------ CALCULATE COMPUTER SPEED USING LOOP AND MTIMER --------
mtimer
for t&=0 to 10000
tmp%=inp(dataport%)
for n&=0 to 2
incr sptest&
decr sptest&
next n&
next t&
ppcnt& = mtimer
if ppcnt& < 9333 then ppcnt&=9333 '--- set minimum for ppcnt&
'--- set palette colors and draw background --
palette using pal%(0)
gosub bckdraw
'if maxtools%=0 then maxtools%=100:dim doffset#(maxtools%):dim hoffset&(maxtools%)
'-------------calc bit mask settings -------------------
gosub maskcalc
gosub port_clear '---- setup ports inputs and outputs
'------- set interrupt vector for timing control!------
gosub setirq
'------- set interrupt vector for rtc interrupt for additional timer ---
gosub settime_int
gosub sethirq '----- setup port interrupt handler
'-------------- DON'T do this , it messes it up! -------
'for t%=0 to 4 '--- preload the move data structs to default data
'mdat(t%).Fline="XYZA"
'call line_read# (bycopy t% ,mdat(),wrk())
'next t%
'------------------------- START HERE -----------------------
'---- turn on caps lock ----
def seg=&h40
d?=peek (&h0017)
poke &h0017,(d? or &h40)
gosub str_key_filter
gosub sreset
gosub vline
gosub displaytool
'gosub dist_to_go
'gosub page1
gosub newfeed 'initilize feed so it don't hang if ran with no feedrate
gosub opnfile
sng_block%=1
ky$=chr$(0,65) :goto rescan '---- start in single run mode!
kwait:
while not instat '---- wait for keypress
if pg%=0 then gosub clkdsp:gosub page1
'gosub displaytool
'if m_ready% then gosub M_exc
wend
'------------------read key, x= quit! "ESC"= reset ----
ky$=inkey$
rescan:
if menu%=1 then
if ky$=chr$(0,59) then gosub setfile:goto rescan
'if ky$=chr$(0,60) then ky$="" 'gosub setedit:goto rescan
if ky$=chr$(0,61) then gosub settool:goto rescan
if ky$=chr$(0,62) then gosub setwkoff:goto rescan
'if ky$=chr$(0,63) then gosub setup:goto rescan
else
gosub mankeys
end if
menu1:
kmnu:
if ky$=chr$(0,63) then gosub setup:goto rescan
if ky$=chr$(0,64) then gosub setmdi:goto rescan
if ky$=chr$(0,65) then
auto%=0
gosub filerun
goto rescan
end if
if Ky$=chr$(0,66) then auto%=1:gosub filerun:goto rescan
if ky$=chr$(0,67) then gosub setjog :goto rescan
if ky$=chr$(0,68) then gosub sethandle :goto rescan
if ky$=chr$(0,133) or ky$=chr$(0,134) or ky$=chr$(0,84) or ky$=chr$(0,85) then gosub setmenu
goto kwait
'---------------------- key scan 1 ------------------
'------------- un-encrypt string drcy$ with key nuky? returns nu1$ -------
decode:
nuky?=45
nu1$=""
for t%= 1 to len(dcry$)
fst1?=ascii(mid$(dcry$,t%,1))
fst2?=fst1? - t%*nuky?
nu1$=nu1$ + chr$(fst2?)
next t%
return
'----------------------------------------------------------------
setpal:
dim pal%(16)
pal%(0)=0
pal%(1)=56
pal%(2)=24
pal%(3)=3
pal%(4)=20
pal%(5)=14
pal%(6)=42
pal%(7)=7
pal%(8)=8
pal%(9)=16
pal%(10)=4
pal%(11)=28
pal%(12)=22
pal%(13)=23
pal%(14)=26
pal%(15)=63
return
filerun:
hlp$(0)="RUN = Enter RESET = Esc"
hlp$(1)="HOLD = Space MENU = F12"
hlp$(2)="EDIT = F2 RPM = < >"
hlp$(3)=" FEED = +/-"
hlp$(4)="CURSOR = "+chr$(24)+chr$(25)+" Home/End Page = up/dn"
if helpbit% then gosub help_dsp
pg%=0
if auto%=0 then mode$=" RUN SINGLE":gosub selects
if auto%=1 then mode$=" RUN AUTO ":gosub selects
if fload%=0 then gosub vline
'if fload%=0 or fload%=1 then gosub vline
'--------------- moves the line cursor and pages thru file ------
rkey:
while not instat
if in_op%=0 and cancyc%=0 and ll% then gosub vline:ll%=0
gosub clkdsp
gosub page1
gosub autoread
if do_reset% and mov%=0 then gosub sreset:lptr&=0:cusr%=0:gosub vline
if cancyc% and arun% and mov%=0 and in_op%=0 then gosub cancycle
if m_ready% then gosub M_exc
wend
ky$=inkey$
'-----------------------------
if ky$=chr$(27) then gosub sreset
if mov% then goto skpky
if ky$=chr$(0,72) then
if fload%=1 then gosub upd_pos
rechk1:
if lptr&+cusr% > 1 then
if right$(super_array$(3,lptr&+cusr%-2,""),1) = chr$(0) then
' if right$(lbuf(lptr&+cusr%-2),1) = chr$(0) then
if cusr% > 0 then decr cusr% else if lptr& > 0 then decr lptr&
else
if cusr% > 0 then decr cusr% else if lptr& > 0 then decr lptr&
goto rechk1
end if
else
if cusr% > 0 then decr cusr% else if lptr& > 0 then decr lptr&
end if
gosub vline
end if
if ky$=chr$(0,80) then
if fload%=1 then gosub upd_pos
if right$(super_array$(3,lptr&+cusr%,""),1) = chr$(0) then
'if right$(lbuf(lptr&+cusr%),1) = chr$(0) then
if cusr% < w3.v-1 then incr cusr% else if lptr&+cusr% < numl&+addlines% then incr lptr&
else
rechk2:
if cusr% < w3.v-1 then incr cusr% else if lptr&+cusr% < numl&+addlines% then incr lptr&
if right$(super_array$(3,lptr&+cusr%-1,""),1) <> chr$(0) then goto rechk2
'if right$(lbuf(lptr&+cusr%-1),1) <> chr$(0) then goto rechk2
end if
gosub vline
end if
if fload% then goto skpky
if ky$=chr$(0,73) then
decr lptr&,w3.v:if lptr& < 0 then lptr&=0
rechk3:
if lptr&+cusr% > 1 then
if right$(super_array$(3,lptr&+cusr%-1,""),1) <> chr$(0) then
'if right$(lbuf(lptr&+cusr%-1),1) <> chr$(0) then
if cusr% > 0 then decr cusr% else if lptr& > 0 then decr lptr&
goto rechk3
end if
end if
end if
if ky$=chr$(0,81) then
incr lptr&,w3.v:if lptr& > numl&-w3.v then lptr&=numl&-w3.v+1
rechk4:
if lptr&+cusr% < numl& then
if right$(super_array$(3,lptr&+cusr%-1,""),1) <> chr$(0) then
'if right$(lbuf(lptr&+cusr%-1),1) <> chr$(0) then
if cusr% < w3.v-1 then incr cusr% else if lptr& < numl& then incr lptr&
goto rechk4
end if
end if
if lptr&<0 then lptr&=0
end if
if ky$=chr$(0,71) then lptr&=0:cusr%=0
if ky$=chr$(0,79) then lptr&=numl&+addlines%-w3.v+1 :if lptr&<0 then lptr&=0
'if ky$=chr$(0,71) then cusrx%=0
if ky$=chr$(0,79) then cusrx%=len(super_array$(3,lptr&+cusr%,""))
'if ky$=chr$(0,79) then cusrx%=len(lbuf(lptr&+cusr%))
if ky$ = chr$(0,63) then goto back2
if ky$ = chr$(0,64) then goto back2
if ky$ = chr$(0,67) then goto back2
if ky$ = chr$(0,68) then goto back2
skpky:
if menu% then
if ky$ = chr$(0,59) then goto back2
if ky$ = chr$(0,61) then goto back2
if ky$ = chr$(0,62) then goto back2
if ky$ = chr$(0,60) then gosub setedit:goto filerun
else
gosub mankeys
end if
if ky$=chr$(44) then if spcnt% > minsovr% then decr spcnt% ,rpminc%:gosub newrpm
if ky$=chr$(46) then if spcnt% < maxsovr% then incr spcnt% ,rpminc%:gosub newrpm
'if ky$ = "=" then
if ky$ = chr$(61) or ky$ = chr$(43) then
if extfeed% then
if mdat(1).Fval < maxfeed! then incr mdat(1).Fval,feedinc!
if mdat(2).Fval < maxfeed! then incr mdat(2).Fval,feedinc!
if mdat(3).Fval < maxfeed! then incr mdat(3).Fval,feedinc!
if Fval! < maxfeed! then incr Fval!,feedinc!
if feed1! < maxfeed! then incr feed1!,feedinc!
if mov_F! < maxfeed! then incr mov_F!,feedinc!
'gosub newfeed
updfeed%=1
else
if lastfin? < 20 then
incr lastfin?
'gosub newfeed
updfeed%=1
else
if mdat(1).Fval < maxfeed! then incr mdat(1).Fval,feedinc!
if mdat(2).Fval < maxfeed! then incr mdat(2).Fval,feedinc!
if mdat(3).Fval < maxfeed! then incr mdat(3).Fval,feedinc!
if Fval! < maxfeed! then incr Fval!,feedinc!
if feed1! < maxfeed! then incr feed1!,feedinc!
if mov_F! < maxfeed! then incr mov_F!,feedinc!
'gosub newfeed
updfeed%=1
end if
end if
end if
'if ky$ = "-" then
if ky$ = chr$(45) then
if extfeed% then
if mdat(1).Fval > feedinc! then decr mdat(1).Fval,feedinc!
if mdat(2).Fval > feedinc! then decr mdat(2).Fval,feedinc!
if mdat(3).Fval > feedinc! then decr mdat(3).Fval,feedinc!
if Fval! > feedinc! then decr Fval!,feedinc!
if feed1! > feedinc! then decr feed1!,feedinc!
if mov_F! > feedinc! then decr mov_F!,feedinc!
'gosub newfeed
updfeed%=1
else
if lastfin? > 1 then
decr lastfin?
'gosub newfeed
updfeed%=1
else
if mdat(1).Fval > feedinc! then decr mdat(1).Fval,feedinc!
if mdat(2).Fval > feedinc! then decr mdat(2).Fval,feedinc!
if mdat(3).Fval > feedinc! then decr mdat(3).Fval,feedinc!
if Fval! > feedinc! then decr Fval!,feedinc!
if feed1! > feedinc! then decr feed1!,feedinc!
if mov_F! > feedinc! then decr mov_F!,feedinc!
'gosub newfeed
updfeed%=1
end if
end if
end if
if ky$=chr$(27) then gosub sreset
if ky$ = chr$(0,65) then '--- F7 switch to single block mode auto%=0 ---
auto%=0 : sng_block%=1
'if cancyc%=0 then arun%=0 ' this must be not set or may single block in TAP CYCLE!
if mov% then '--- set current move to full deceleration
decl&=1
last_decl&=1 '--- set last deceleration to full so next acceleration is full also
last_declmod!=0
end if
goto filerun
end if
'--- F8 auto mode ----
if ky$ = chr$(0,66) then
auto%=1
'if cancyc%=0 then arun%=0
goto filerun
end if
if ky$=chr$(0,133) or ky$=chr$(0,134) or ky$=chr$(0,84) or ky$=chr$(0,85) then gosub setmenu
if ky$=chr$(13) and estop%=0 and mov%=0 then
ky$=""
if fload%=0 then gosub reloadfile
if auto%=1 then sng_block%=0
arun%=1
gosub loadf
end if
if ky$=" " and mov%=1 and estop%=0 and ehold%=0 then ky$="":gosub fhold
if ky$=chr$(13) and estop%=1 then
ky$="":estop%=0
if auto%=0 then mode$=" RUN SINGLE" else mode$=" RUN AUTO "
end if
'if mov(os%).exc=0 and estop%=0 and cancyc%=0 then gosub vline:gosub displaytool
if in_op%=0 and cancyc%=0 then gosub vline:gosub displaytool
goto rkey
back2:
return
'------------------------- File Edit -------------
setedit:
hlp$(0)="FILE TOP = Ctrl+Home FIND = Ctrl+F"
hlp$(1)="FILE END = Ctrl+End EXIT = Esc"
hlp$(2)="SAVE CURRENT FILE WITH NEW NAME = Crtl+S"
hlp$(3)="GOTO BLOCK = Crtl+B"
hlp$(4)="CURSOR = "+chr$(24)+chr$(25)+" Home/End Page = up/dn"
if helpbit% then gosub help_dsp
edit%=1:cusrx%=0
gosub selects
gosub chop
gosub vline
k2:
while not instat
gosub clkdsp
loop
ky$= inkey$
if ky$=chr$(19) then
prompt$="SAVE ACTIVE FILE WITH NEW NAME"
tmp$=filename$
filename$ = ucase$( gettext$ (filename$,prompt$,34,20,10,bycopy w7.cf,bycopy w7.cb))
if tmp$ <> filename$ then
if instr(filename$,".") = 0 then filename$=filename$+dfext$
gosub savcurfile:gosub opnfile
end if
gosub bckdraw
if helpbit% then gosub help_dsp
gosub page1
gosub vline
gosub displaytool
end if
if ky$=chr$(6) then
prompt$="FIND ? "
find$ = ucase$(gettext$ (find$,prompt$,24,30,14,bycopy w7.cf,bycopy w7.cb))
if find$ <>"" then
t&=lptr&+cusr%+1:found%=0
while t& < numl&+addlines% and found%=0
incr t&
found% = instr(super_array$(3,(t&),""),find$)
'found% = instr(lbuf(t&),find$)
if found% then lptr&=t&-cusr%:cusrx%=found%-1
wend
end if
gosub bckdraw
if helpbit% then gosub help_dsp
gosub page1
gosub vline
gosub displaytool
end if
'---------- GOTO BLOCK -------
if ky$=chr$(2) then
prompt$="BLOCK ? "
blk_find& = val(gettext$ (str$(blk_find&),prompt$,24,30,14,bycopy w7.cf,bycopy w7.cb))
if blk_find& < numl& then
else
blk_find& = numl&
end if
lptr& = blk_find&-3
if lptr& < 0 then lptr&=0
cusr%=2
gosub bckdraw
if helpbit% then gosub help_dsp
gosub page1
gosub vline
gosub displaytool
end if
if ky$ = chr$(27) then
edit%=0
if fchanged% then
msg$="SAVE BACK TO FILE Y/N"
gosub message
while not instat
loop
if ucase$(inkey$)="Y" then gosub savcurfile
msg$=""
gosub message
end if
goto xit
end if
if ky$=chr$(0,73) then decr lptr&,w3.v:if lptr& < 0 then lptr&=0
if ky$=chr$(0,81) then
incr lptr&,w3.v:if lptr& > numl&-w3.v then lptr&=numl& - w3.v+1
if lptr& < 0 then lptr&=0
end if
if ky$=chr$(0,119) then lptr&=0:cusr%=0
if ky$=chr$(0,117) then lptr&=numl&+addlines%-w3.v+1:if lptr&<0 then lptr&=0
if ky$=chr$(0,72) then
if lptr&+cusr% > 0 then
if cusr% > 0 then decr cusr% else if lptr& > 0 then decr lptr&
t%= instr(super_array$(3,lptr&+cusr%,""),any chr$(0)+chr$(255))-1
't%= instr(lbuf(lptr&+cusr%),any chr$(0)+chr$(255))-1
if t%<0 then t%=0
if t% < cusrx% then cusrx% = t%
end if
end if
if ky$=chr$(0,80) then
if lptr&+cusr% < numl&+addlines% then
if cusr% < w3.v-1 then incr cusr% else incr lptr&
t%= instr(super_array$(3,lptr&+cusr%,""),any chr$(0)+chr$(255))-1
't%= instr(lbuf(lptr&+cusr%),any chr$(0)+chr$(255))-1
if t%<0 then t%=0
if t% < cusrx% then cusrx% = t%
end if
end if
if ky$=chr$(0,71) then cusrx%=0
if ky$=chr$(0,79) then cusrx%=instr(super_array$(3,lptr&+cusr%,""),any chr$(0)+chr$(255))-1
'if ky$=chr$(0,79) then cusrx%=instr(lbuf(lptr&+cusr%),any chr$(0)+chr$(255))-1
if ky$=chr$(0,77) then
if right$(super_array$(3,lptr&+cusr%,""),1) <> chr$(0) then
'if right$(lbuf(lptr&+cusr%),1) <> chr$(0) then
if cusrx% < %line_length-1 then
incr cusrx%
else
if cusr% < w3.v-2 then incr cusr% else incr lptr&
cusrx%=0
end if
else
if edchr$ <> chr$(0) then incr cusrx%
end if
end if
if ky$=chr$(0,75) then
if cusrx% > 0 then
decr cusrx%
else
if lptr&+cusr% > 0 and right$(super_array$(3,lptr&+cusr%-1,""),1) <> chr$(0) then
'if lptr&+cusr% > 0 and right$(lbuf(lptr&+cusr%-1),1) <> chr$(0) then
if cusr% < 1 then decr lptr& else decr cusr%
cusrx% = %line_length-1
end if
end if
end if
if ky$=chr$(0,83) then
ky$=""
if edchr$ = chr$(0) or edchr$ = chr$(255) then
if lptr&+cusr% < numl&+addlines% then
if cusrx%=0 then
gosub line_del
fchanged%=1
else
tmp$=edstr1$ + left$(super_array$(3,lptr&+cusr%+1,""),instr(super_array$(3,lptr&+cusr%+1,""),any chr$(255)+chr$(0))-1)
'tmp$=edstr1$ + left$(lbuf(lptr&+cusr%+1),instr(lbuf(lptr&+cusr%+1),any chr$(255)+chr$(0))-1)
gosub breakline
incr cusr%
gosub line_del
decr cusr%
fchanged%=1
end if
end if
else
if cusrx% < %line_length-1 then
er$=super_array$(2,lptr&+cusr%, edstr1$+edstr2$)
'lbuf(lptr&+cusr%) = edstr1$+edstr2$
fchanged%=1
end if
end if
end if
if ky$=chr$(8) then
ky$=""
if cusrx% > 0 then
if len(edstr1$) > 0 then edstr1$ = left$ (edstr1$,len(edstr1$)-1)
er$=super_array$(2,lptr&+cusr%, edstr1$+edchr$+edstr2$):decr cusrx%
'lbuf(lptr&+cusr%) = edstr1$+edchr$+edstr2$:decr cusrx%
fchanged%=1
else
decr cusr%
cusrx%=instr(super_array$(3,lptr&+cusr%,""),any chr$(255)+chr$(0))-1
'cusrx%=instr(lbuf(lptr&+cusr%),any chr$(255)+chr$(0))-1
tmp$ = left$(super_array$(3,lptr&+cusr%,""),cusrx%) + left$(super_array$(3,lptr&+cusr%+1,""),instr(super_array$(3,lptr&+cusr%+1,""),any chr$(255)+chr$(0))-1)
'tmp$ = left$(lbuf(lptr&+cusr%),cusrx%) + left$(lbuf(lptr&+cusr%+1),instr(lbuf(lptr&+cusr%+1),any chr$(255)+chr$(0))-1)
gosub breakline
incr cusr%
gosub line_del
decr cusr%
fchanged%=1
end if
end if
if ky$ > chr$(31) and ky$ < chr$(123) then
if instr(super_array$(3,lptr&+cusr%,""),any chr$(255)+chr$(0)) < %line_length then
'if instr(lbuf(lptr&+cusr%),any chr$(255)+chr$(0)) < %line_length then
er$=super_array$(2,lptr&+cusr%, edstr1$+ucase$(ky$)+edchr$+edstr2$)
'lbuf(lptr&+cusr%) = edstr1$+ucase$(ky$)+edchr$+edstr2$
incr cusrx%:fchanged%=1
end if
end if
'--------------------- inserts a line --------
if ky$=chr$(13) then
gosub line_add
fchanged%=1
end if
'---------------------
gosub chop
gosub vline
goto k2
breakline:
if len(tmp$) > %line_length - 1 then
er$=super_array$(2,lptr&+cusr%,left$(tmp$,%line_length -1) + chr$(255))
'lbuf(lptr&+cusr%)=left$(tmp$,%line_length -1) + chr$(255)
er$=super_array$(2,lptr&+cusr%+1,mid$(tmp$,%line_length ))
'lbuf(lptr&+cusr%+1)=mid$(tmp$,%line_length )
else
er$=super_array$(2,lptr&+cusr%,tmp$)
'lbuf(lptr&+cusr%)=tmp$
end if
return
chop:
if cusrx%=0 then edstr1$="" else edstr1$=mid$(super_array$(3,lptr&+cusr%,""),1,cusrx%)
'if cusrx%=0 then edstr1$="" else edstr1$=mid$(lbuf(lptr&+cusr%),1,cusrx%)
edchr$=mid$(super_array$(3,lptr&+cusr%,""),cusrx%+1,1)
'edchr$=mid$(lbuf(lptr&+cusr%),cusrx%+1,1)
edstr2$=mid$(super_array$(3,lptr&+cusr%,""),cusrx%+2)
'edstr2$=mid$(lbuf(lptr&+cusr%),cusrx%+2)
return
line_add:
incr addlines%
t&=numl&+addlines%
while t& > lptr&+cusr%
er$=super_array$(2,t&, super_array$(3,t&-1,""))
'lbuf(t&) = lbuf(t&-1)
decr t&
wend
er$=super_array$(2,t&,edstr1$)
'lbuf(t&)=edstr1$
er$=super_array$(2,t&+1,edchr$+edstr2$)
'lbuf(t&+1)=edchr$+edstr2$
if cusr% < w3.v-1 then incr cusr% else incr lptr&
cusrx%=0
return
line_del:
decr addlines%
t&=lptr&+cusr%
while t& < numl&+addlines%
er$=super_array$(2,t&, super_array$(3,t&+1,""))
'lbuf(t&) = lbuf(t&+1)
incr t&
wend
er$=super_array$(2,t&,"")
'lbuf(t&)=""
return
savcurfile:
'if fchanged%=0 then return
msg$="SAVING FILE"
gosub message
t&=0:fchanged%=0
650 if instr(filename$,ANY ":\")=0 then
open dirname$+filename$ for output as 1
else
open filename$ for output as 1
end if
while t& < numl& + addlines%
l$=""
nubuf:
if right$(super_array$(3,t&,""),1) = chr$(0) then
'if right$(lbuf(t&),1) = chr$(0) then
l$ =l$ + left$(super_array$(3,t&,""),instr(super_array$(3,t&,""),chr$(0))-1)
'l$ =l$ + left$(lbuf(t&),instr(lbuf(t&),chr$(0))-1)
else
l$=l$+ left$(super_array$(3,t&,""),instr(super_array$(3,t&,""),any chr$(255)+chr$(0))-1)
'l$=l$+ left$(lbuf(t&),instr(lbuf(t&),any chr$(255)+chr$(0))-1)
incr t&:goto nubuf
end if
print# 1,l$
incr t&
wend
close #1
msg$=""
gosub message
'------------ stop file from reloading after save! ---
'tl&=lptr&:tl%=cusr%
'gosub opnfile
'lptr&=tl&:cusr%=tl%
652 return
'-------------------- Print misc, values -----------
ds:
'view text (w6.x,w6.y+1)-(w6.x+w6.h,w6.y+w6.v)
'print f$
'print dirname$+filename$
return
getblock: '--- find the current block number
if fload% then
oout%=mdat(1).Oval
nout&=mdat(1).Nval
if nextline% then
pblk&=mdat(2).lnum+1
else
pblk&=mdat(1).lnum+1
end if
else
pblk&=lptr&+cusr%+1
nout&=Nval&
oout%=Oval%
end if
!cli
blk$=str$(pblk&)
nnum$=str$(nout&)
onum$=str$(oout%)
!sti
blk$="BLOCK"+blk$+" "+string$(8,chr$(205))
nnum$="N"+nnum$+" "+string$(8,chr$(205))
onum$="O"+onum$+" "+string$(5,chr$(205))
return
'------------------------------ View Lines of File -----------------
vline:
gosub getblock
view text (w3.x+2,w3.y-1)-(w3.x+w3.h-1,w3.y-1)
color w3.bdr,w3.cb
print using" \ \";nnum$;
print using" \ \";onum$;
print using" \ \";blk$;
view text (w3.x,w3.y)-(w3.x+w3.h,w3.y+w3.v)
color w3.cf,w3.cb
cls
if auto%=0 then
if in_op% then dl&=cur_lnum& -2 else dl&=mdat(2).lnum-2
end if
if auto% then
if in_op% then dl&=cur_lnum& -2 else dl&=cur_lnum&-1
end if
for t%=0 to w3.v - 1
if fload%=0 then
if edit%=0 then
if cusr% = t% then print "> " super_array$(3,t%+lptr&,"") else print " " super_array$(3,t%+lptr&,"")
else
if cusr% = t% then
print "> " edstr1$;
color w3.cf,w3.hb:print edchr$;
color w3.cf,w3.cb:print edstr2$
else
print " " super_array$(3,t%+lptr&,"")
end if
end if
end if
if fload%=1 then
if dl&+t% < 0 then
print""
else
if t%=2 and in_op% then
color w3.hf,w3.cb:print"> " super_array$(3,dl&+t%,"")
else
if t%=2 and in_op%=0 then
color w3.hf,w3.cb :print "> ";
color w3.cf,w3.cb :print super_array$(3,dl&+t%,"")
else
color w3.cf,w3.cb:print " " super_array$(3,dl&+t%,"")
end if
end if
end if
end if
next t%
return
autoread:
if in_op%=0 and auto% and fload% and arun% and mov%=0 and cancyc%=0 and estop%=0 then gosub loadf
'---- mdat().look is set to 1 to indicate next move cannot be read ahead
if do_reset% then return
'---- setting buffer% =0 will stop read ahead!!!!
'buffer1%=1
if buffer1% then
if next_op% = 0 and auto% and arun% and fload% and cancyc%=0 and estop%=0 then gosub loadf
'if next_op% = 0 and mdat(2).look =0 and auto% and arun% and fload% and cancyc%=0 and estop%=0 then gosub loadf
end if
if lptr& > numl&+4 then
lptr&=numl&+2
gosub sreset ':if auto% < 2 then gosub vline
end if
'if lptr& > numl&+2 then arun%=0:fload%=0 'gosub sreset:if auto% < 2 then gosub vline
return
'-------------------------------
reloadfile:
fload%=1
os2%=1
lptr&=lptr&+cusr% : cusr%=0
for t%=0 to 1
gosub lineread
if Lval%(sublevel%) = 0 then incr lptr&
next t%
if requpd%=0 then gosub vline
dspf%=1
return
loadf:
if requpd% then gosub upd_pos
if cancyc% then return
gosub lineread
if auto%=0 then arun%=0
os2%=1
'--------------------- set dir bits if plane changes -------
newplane% = mdat(1).g2
if lastplane% <> newplane% then gosub setdirbits 'check for plane change
if mdat(1).g9 = 80 then gosub offset:gosub movecalc
if mdat(1).g9 <> 80 then gosub cancycle
if abrt%=1 then gosub sreset
'end if
'if auto%=0 and cancyc% then arun%=0 '--- changes back to single block after
'--------
if Lval%(sublevel%) = 0 then incr lptr&
'--------
'nextline%=1
return
'------------ lines from line buffer "lbuf" starting at line 5 ----
'------------ and save in struct 0-3
lineread:
'------- reads new line into struct 3 --
'-------- others are shifted ahead ----
for nxtl% = 0 to 2
mdat(nxtl%) = mdat(nxtl%+1)
next nxtl%
incr nxtl%
if multimove% then decr lptr& '----- set the line pointer back to rerun last line--
!cli
if lptr& < numl& then
tmp$=super_array$(3,lptr&,"")
'tmp$=lbuf(lptr&)
adline:
if right$(tmp$,1) <> chr$(0) then
incr lptr&
tmp$=left$(tmp$,instr(tmp$,chr$(255)) - 1) + super_array$(3,lptr&,"")
'tmp$=left$(tmp$,instr(tmp$,chr$(255)) - 1) + lbuf(lptr&)
goto adline
else
mdat(3).Fline = tmp$
end if
else
mdat(3).Fline = "%"
end if
nextline%=0
call line_read# (3,mdat(),wrk()) '------ call line read to get values!
!sti
return
'------- super array function 1= create 2=store 3=retrieve 4=erase -----------
function super_array$ (oper%,line_loc&,dta$ ) public static
max_lines&=882687
super_array$="0"
If line_loc& > max_lines&*8 then super_array$="-1":goto tm_lines
select case oper%
case = 1: gosub make_array
case = 2: gosub save_ems
case = 3: gosub read_ems
case = 4: gosub del_ems
end select
tm_lines:
oper%=0
exit function
make_array:
pgm_lines&=line_loc&
if pgm_lines& < max_lines& then
dim virtual lbuf1 (pgm_lines& +100) as string * %line_length
goto fin_sub
else
dim virtual lbuf1 (max_lines&) as string * %line_length
decr pgm_lines& , max_lines&
end if
if pgm_lines& > max_lines& then
dim virtual lbuf2 (max_lines&) as string * %line_length
else
dim virtual lbuf2 (pgm_lines& +100) as string * %line_length
goto fin_sub
end if
decr pgm_lines& , max_lines&
if pgm_lines& > max_lines& then
dim virtual lbuf3 (max_lines&) as string * %line_length
else
dim virtual lbuf3 (pgm_lines& +100) as string * %line_length
goto fin_sub
end if
decr pgm_lines& , max_lines&
if pgm_lines& > max_lines& then
dim virtual lbuf4 (max_lines&) as string * %line_length
else
dim virtual lbuf4 (pgm_lines& +100) as string * %line_length
goto fin_sub
end if
decr pgm_lines& , max_lines&
if pgm_lines& > max_lines& then
dim virtual lbuf5 (max_lines&) as string * %line_length
else
dim virtual lbuf5 (pgm_lines& +100) as string * %line_length
goto fin_sub
end if
decr pgm_lines& , max_lines&
if pgm_lines& > max_lines& then
dim virtual lbuf6 (max_lines&) as string * %line_length
else
dim virtual lbuf6 (pgm_lines& +100) as string * %line_length
goto fin_sub
end if
decr pgm_lines& , max_lines&
if pgm_lines& > max_lines& then
dim virtual lbuf7 (max_lines&) as string * %line_length
else
dim virtual lbuf7 (pgm_lines& +100) as string * %line_length
goto fin_sub
end if
decr pgm_lines& , max_lines&
if pgm_lines& > max_lines& then
dim virtual lbuf8 (max_lines&) as string * %line_length
else
dim virtual lbuf8 (pgm_lines& +100) as string * %line_length
end if
fin_sub:
super_array$="1"
return
'-------write to ems-------
save_ems:
select case line_loc&
case < max_lines&
lbuf1(line_loc&) = dta$
case < max_lines& * 2
lbuf2 (line_loc& - max_lines&) = dta$
case < max_lines& * 3
lbuf3 (line_loc& - max_lines& *2)=dta$
case < max_lines& * 4
lbuf4 (line_loc& - max_lines& *3)=dta$
case < max_lines& * 5
lbuf5 (line_loc& - max_lines& *4)=dta$
case < max_lines& * 6
lbuf6 (line_loc& - max_lines& *5)=dta$
case < max_lines& * 7
lbuf7 (line_loc& - max_lines& *6)=dta$
case < max_lines& * 8
lbuf8 (line_loc& - max_lines& *7)=dta$
end select
super_array$="1"
return
'--------read from ems---------
read_ems:
select case line_loc&
case < max_lines&
rd$ = lbuf1 (line_loc&)
case < max_lines& * 2
rd$ = lbuf2 (line_loc& - max_lines&)
case < max_lines& * 3
rd$ = lbuf3 (line_loc& - max_lines& *2)
case < max_lines& * 4
rd$ = lbuf4 (line_loc& - max_lines& *3)
case < max_lines& * 5
rd$ = lbuf5 (line_loc& - max_lines& *4)
case < max_lines& * 6
rd$ = lbuf6 (line_loc& - max_lines& *5)
case < max_lines& * 7
rd$ = lbuf7 (line_loc& - max_lines& *6)
case < max_lines& * 8
rd$ = lbuf8 (line_loc& - max_lines& *7)
end select
super_array$=rd$
return
'------------------------------
del_ems:
erase lbuf1
erase lbuf2
erase lbuf3
erase lbuf4
erase lbuf5
erase lbuf6
erase lbuf7
erase lbuf8
super_array$="1"
END FUNCTION
'-------------------- open nc file for input -------------------
opnfile:
msg$="READING FILE"
gosub message
addlines%=0
maxems&=fre(-11):maxmem&= fre(-1)
if instr(filename$,ANY ":\") = 0 then
nuf$ = dirname$+filename$
else
nuf$ = filename$
end if
f$ = dir$ (nuf$)
if f$="" or instr(nuf$,f$) =0 then gosub nofile:return
er$=super_array$(4,0,"") '------ erase super_array$
'erase lbuf
msg$="Checking File Size"
gosub message
numl&=0:lptr&=0:cusr%=0
fchanged%=0
open nuf$ for input as 1
while not eof(1)
line input #1,l$:incr numl&
llgth%=len(l$):incr numl&,fix( llgth% / %line_length)
wend
close #1
msg$=""
gosub message
msg$= "Reading" + str$(numl&) + " Lines"
gosub message
'$IF %USE_EMS
if maxems& < ((numl&+1000) * %line_length) then
fail$=" NOT ENOUGH FREE EXPANDED MEMORY"
'dim lbuf (100) as string * %line_length
goto nofile
else
er$=super_array$(1,numl&+500,"") '----- create super array!
'dim virtual lbuf (numl&+500) as string * %line_length
end if
'$ELSE
'if maxmem& < ((numl&+100) * %line_length) then
'fail$=" NOT ENOUGH FREE MEMORY"
'dim lbuf (100) as string * %line_length
'goto nofile
'else
'dim lbuf (numl&+100) as string * %line_length
'end if
'$ENDIF
open nuf$ for input as 1
t&=0
while not eof(1)
line input #1,linein$
nxtscn:
if len(linein$) > %line_length - 1 then
er$=super_array$(2,t&,left$(linein$,%line_length -1) + chr$(255))
'lbuf(t&)=left$(linein$,%line_length -1) + chr$(255)
linein$=mid$(linein$,%line_length )
incr t&
goto nxtscn
else
er$=super_array$(2,t&,linein$)
'lbuf(t&)=linein$
incr t&
end if
wend
close #1
lptr&=0
msg$=""
gosub message
return
'----------------------- end file load ---------
nofile:
numl&=6
er$=super_array$(2,1,"File not found or too large!")
'lbuf(0)="File not found!"
msg$=""
gosub message
return
'--------------------- SET HANDLE MODE ------------------!!!!!!!!!!!!!!
sethandle:
hlp$(0)="RESET = Esc"
hlp$(1)="MENU = F12"
hlp$(2)="RPM = < >"
hlp$(3)="SAVE POINT TO FILE = P"
hlp$(4)=""
if helpbit% then gosub help_dsp
auto%=3
mode$=" HANDLE "
if mov%=1 then gosub fhold
pg%=0
gosub selects
gosub vline
hdat%=0
dat1!=0 'clear counter
handx&=0:handy&=0:handz&=0:handw&=0::handcount&=0 'handadder%*2
if exthand% = 1 then
'------------------- enable pic interrupt
!cli
out &h21,(inp(&h21) and not hpic%)
!sti
handbit%=1 '----turn on hand mode ----
end if
gosub newfeed
hnewkey:
while not instat
gosub clkdsp
gosub page1
stat2? = (inp(statusport2%) xor &h80) and &h88
dat2? = (inp(dataport2%) and &hc0)
rotate left dat2?,2
if dat2? <> lastdat2? then lastdat2?=dat2?:hdat%=0:handcount&=0 'handadder%*2
if stat2? <> laststat2? then
laststat2?=stat2?:hdat%=0:handcount&=0 'handadder%*2
if stat2? = 8 then hinc%=h1pulse% : hstep%=h1step%
if stat2? = 128 then hinc%=h10pulse% : hstep%=h10step%
if stat2? = 136 then hinc%=h100pulse% : hstep%=h100step%
end if
if hdat% >= hinc% then
decr hdat%,hinc%: incr handcount& ,(handadder% * hstep%)
end if
if handcount& >= handcarry% then
handcount1%= handcount&/handcarry%
decr handcount&,(handcarry% * handcount1%)
!cli
select case dat2?
case=0:incr handx&,handcount1%
case=1:incr handy&,handcount1%
case=2:incr handz&,handcount1%
case=3:incr handw&,handcount1%
end select
!sti
end if
if hdat% <= -hinc% then
incr hdat%,hinc%: decr handcount& , (handadder% * hstep%)
end if
if handcount& <= -handcarry% then
handcount1% = handcount&/handcarry%
decr handcount&,(handcarry% * handcount1%)
!cli
select case dat2?
case=0:incr handx&,handcount1%
case=1:incr handy&,handcount1%
case=2:incr handz&,handcount1%
case=3:incr handw&,handcount1%
end select
!sti
end if
wend
ky$=inkey$
if ucase$(ky$)=chr$(80) and savedat% then
gosub logpoint ':msg$="Point "+str$(datpoint%)
gosub message
goto hnewkey
end if
if ky$=chr$(44) then
if spcnt% > minsovr% then decr spcnt% ,rpminc%:gosub newrpm
goto hnewkey
end if
if ky$=chr$(46) then
if spcnt% < maxsovr% then incr spcnt% ,rpminc%:gosub newrpm
goto hnewkey
end if
if ky$=chr$(0,133) or ky$=chr$(0,134) or ky$=chr$(0,84) or ky$=chr$(0,85) then gosub setmenu:goto hnewkey
if menu%=1 then goto hmenu
if ky$=chr$(0,59) then gosub setspndl:goto hnewkey
if ky$=chr$(0,60) then gosub setsdir:goto hnewkey
if ky$=chr$(0,61) then gosub setcool1:goto hnewkey
if ky$=chr$(0,62) then gosub setcool2:goto hnewkey
'if ky$=chr$(0,63) then gosub setlight:goto hnewkey
hmenu:
if ky$=chr$(0,60) then ky$="":goto hnewkey
if ky$=chr$(27) then gosub sreset:goto hnewkey
if limithit% then dx&=0:dy&=0:dz&=0:dw&=0:estop%=0:es3&=0:limithit%=0
if exthand% = 1 then
handbit%=0
'---- stop hand mode ---
'-------- clear pic interrupt
!cli
out &h21,(inp(&h21) or hpic%)
!sti
end if
gosub upd_pos
msg$="":gosub message
return
'--------------------------- reset handle irq ------------
resethirq:
'disable the pic irq bit mask
handon?=&h20
'!cli
'out &h21,(inp(&h21) or hpic%)
'!sti
'reset old interrupt vector to "whatever"
reg 1 ,(hirq% or &h2500)
reg 4 ,hip1
reg 8 ,hip2
call interrupt (&h21)
'set the printer control port to irq disabled
tmpin?=inp(controlport2%) ':bit toggle tmpin?,2
tmpin?=tmpin? and &h0f
tmpin?=tmpin? or &h20
out controlport2%,tmpin? '(&h20)
return
'-------------------------- set handle irq -----------
sethirq:
'-----------set the printer control port to irq enable
if handirq% = 5 then hirq% = &h0d : hpic%=&h20
if handirq% = 7 then hirq% = &h0f : hpic%=&h80
handon?=&h30
tmpin?=inp(controlport2%) ':bit toggle tmpin?,2
tmpin?=tmpin? and &h0f
tmpin?=tmpin? or &h30
out controlport2%,tmpin?
'get current interrupt vector and save it !
reg 1 ,(hirq% or &h3500)
call interrupt (&h21)
hip1 = reg(2)
hip2 = reg(9)
'set new interrupt vector to "handsub"
reg 1 ,(hirq% or &h2500)
reg 4 ,hipptr
reg 8 ,hipseg
call interrupt (&h21)
'enable the pic irq bit mask
'!cli
'out &h21,(inp(&h21) and not hpic%)
'!sti
return
'------------------------- control port output data -------
control_out:
bit toggle tmpin?,2
out controlport%,tmpin?
return
spdriveout:
while comtmr1?? < comdelay%
wend
print #4,":"+spctl$+chr$(13)+chr$(10)
comtmr1??=0
gosub selects
return
'--------- set gs2 drive spindle rpm ---------
newrpm:
if no_feed_overide% then
sout!=lastsval!
else
sout!=lastsval! * spcnt% / 100
end if
gear?=1
if pwm? then
while ratio!(gear?) * pwmrpm% < (lastsval! * maxsovr% *.01) and gear? < gearcount?
incr gear?
wend
end if
if gsdrive% then
while ratio!(gear?)* motor% < (lastsval! * maxsovr% *.01) and gear? < gearcount?
incr gear?
wend
end if
setgear? = gear? - 1
tmpin?=inp(controlport2%):bit toggle tmpin?,2
tmpin?=tmpin? and &hf0
tmpin?=tmpin? or not setgear?
tmpin?=tmpin? or handon?
bit toggle tmpin?,2
out controlport2%,tmpin?
if pwm? then
maxs!= pwmrpm% * ratio!(gearcount?)
mins!=1
'mins!= pwmrpm% * ratio!(1)
if sout! > maxs! then sout! = maxs!
if sout! < mins! then sout! = mins!
pwmpos% = (pwmmax% -1) * sout!/(pwmrpm% * ratio!(gear?))
end if
if gsdrive% then
'---- use high gear ratio and max freq to find max spindle rpm = maxs! ---
maxs!=freqmax!/freqbase! * motor% * ratio!(gearcount?)
mins!=freqmin!/freqbase! * motor% * ratio!(1)
if sout! > maxs! then sout! = maxs!
if sout! < mins! then sout! = mins!
freqout! = sout! * freqbase! / (motor% * ratio!(gear?))
if freqout! < freqmin! then freqout! = freqmin!
if freqout! > freqmax! then freqout! = freqmax!
newdat$="0106091A"+ right$ ("000"+hex$(freqout!*10),4)
gosub sendGS2
end if
return
sendGS2:
'----- calc crc for GS2 drive newdat$ and send -----
while comtmr1?? < comdelay%
wend
crc?=0
sl%=len(newdat$)
scn%=1
while scn% < sl%
incr crc?,val("&h"+mid$(newdat$,scn%,2))
incr scn%,2
wend
crc?=not crc?
incr crc?
crc$ = right$("0"+hex$(crc?),2)
trans$=":"+newdat$ +crc$+chr$(13)+chr$(10)
print #4,trans$
comtmr1?? = 0
return
'------------------------- F1 key -------------
setspndl:
if gsdrive% then
tmpin?=inp(controlport%):bit toggle tmpin?,2
if spndl%=1 then
spndl%=0:spctl$=spndloff$
bit set tmpin?,sfwdbit?
gosub control_out
gosub spdriveout
else
if spndldir%=1 then spctl$=spndlrev$ else spctl$=spndlfwd$
gosub spdriveout
while comtmr1?? < comdelay%
wend
spndl%=1:spctl$=spndlon$
bit reset tmpin?,sfwdbit?
gosub control_out
gosub spdriveout
end if
return
end if
if spndl%=1 then spndl%=0 else spndl%=1
tmpin?=inp(controlport%):bit toggle tmpin?,2
if spndl%=1 then if spndldir%=0 then bit reset tmpin?,sfwdbit? _
:bit set tmpin?,srevbit?: else bit set tmpin?,sfwdbit? _
:bit reset tmpin?,srevbit?
if spndl%=0 then bit set tmpin?,sfwdbit?:bit set tmpin?,srevbit?
gosub control_out
ky$=""
gosub selects
return
'------------------------- F2 key -------------
setsdir:
if gsdrive% then
if spndldir%=1 then spndldir%=0:spctl$=spndlfwd$ else spndldir%=1:spctl$=spndlrev$
gosub spdriveout
return
end if
tmr1??=0
if spndl%=1 then gosub setspndl:while tmr1?? < spndelay?? :wend: _
if spndldir%=1 then spndldir%=0:gosub setspndl else spndldir%=1:gosub setspndl
if spndl%=0 then if spndldir%=1 then spndldir%=0 else spndldir%=1
ky$=""
gosub selects
return
'------------------------- F3 key -------------
setcool1:
tmpin?=inp(controlport%):bit toggle tmpin?,2
if cool1%=1 then cool1%=0:bit set tmpin?,coolbit? else cool1%=1:bit reset tmpin?,coolbit?
gosub control_out
ky$=""
gosub selects
return
'------------------------- F4 key -------------
setcool2:
if pwm? then return
tmpin?=inp(controlport%):bit toggle tmpin?,2
if cool2%=1 then cool2%=0:bit set tmpin?,coolbit2? else cool2%=1:bit reset tmpin?,coolbit2?
gosub control_out
ky$=""
gosub selects
return
'------------------------- F5 key -------------
setlight:
tmpin?=inp(controlport%):bit toggle tmpin?,2
if light%=1 then light%=0:bit set tmpin?,litbit? else light%=1:bit reset tmpin?,litbit?
gosub control_out
ky$=""
gosub selects
return
'------------------------- F11 key -------------
setmenu:
if menu%=1 then menu%=0 else menu%=1
ky$=""
gosub selects
return
'------------------------ SETUP F5 ------
setup:
auto%=8
mode$=" SETUP "
screen 0,,2,2
maxcon&=fre(-1)
maxems&=fre(-11)
if %USE_EMS then maxlines&= maxems& / %line_length else maxlines&= maxcon& / %line_length
rst1:
view text (1,2)-(80,23)
color w15.hf,bgsetup%
cls
gosub bkgsetup
gosub bkclk
gosub clkdsp
gosub selects
kyin:
'view text (24,3)-(75,4)
'color w10.cf,w10.cb
'if mov%=1 then print" PARAMETERS CANNOT BE CHANGED WHILE IN OPERATION!" else _
' print" "
view text (6,3)-(22,23)
color w15.bdr,w15.cb:print chr$(218) repeat$ (14,chr$(196));:color 7,w15.cb:print chr$(191)
color w15.bdr,w15.cb:print chr$(179);
color w15.cf
if set_op2%=0 then color w15.hf,w15.hb :if ky$=chr$(13) then :goto exitf
print " EXIT CONTROL ";:color 7,w15.cb:print chr$(179)
color w15.bdr,w15.cb:print chr$(192);:color 7,w15.cb:print repeat$(14,chr$(196)) chr$(217)
color w15.bdr,w15.cb:print chr$(218) repeat$ (14,chr$(196));:color 7,w15.cb:print chr$(191)
color w15.bdr,w15.cb:print chr$(179);
color w15.cf
if set_op2%=1 then color w15.hf,w15.hb :if ky$=chr$(13) and mov%=0 and fload%=0 then ky$="":gosub sreset:gosub pramkyin:goto rst1
print " PARAMETERS ";:color 7,w15.cb:print chr$(179)
color w15.bdr,w15.cb:print chr$(192);:color 7,w15.cb:print repeat$(14,chr$(196)) chr$(217)
color w15.bdr,w15.cb:print chr$(218) repeat$ (14,chr$(196));:color 7,w15.cb:print chr$(191)
color w15.bdr,w15.cb:print chr$(179);
color w15.cf
if set_op2%=2 then color w15.hf,w15.hb:if ky$=chr$(13) and mov%=0 and fload%=0then ky$="":gosub sreset:gosub portkyin:goto rst1
print " PORT SETUP ";:color 7,w15.cb:print chr$(179)
color w15.bdr,w15.cb:print chr$(192);:color 7,w15.cb:print repeat$(14,chr$(196)) chr$(217)
view text (24,3)-(40,18)
color w15.bdr,w15.cb:print chr$(218) repeat$ (14,chr$(196));:color 7,w15.cb:print chr$(191)
color w15.bdr,w15.cb:print chr$(179);
color w15.cf
if set_op2%=3 then color w15.hf,w15.hb :if ky$=chr$(13) then gosub setcolor:goto rst1
print " SCREEN COLOR ";:color 7,w15.cb:print chr$(179)
color w15.bdr,w15.cb:print chr$(192);:color 7,w15.cb:print repeat$(14,chr$(196)) chr$(217)
color w15.bdr,w15.cb:print chr$(218) repeat$ (14,chr$(196));:color 7,w15.cb:print chr$(191)
color w15.bdr,w15.cb:print chr$(179);
color w15.cf
if set_op2%=4 then color w15.hf,w15.hb :if ky$=chr$(13) and mov%=0 and fload%=0 then ky$="":gosub sreset:gosub setkyin:goto rst1
print " SETTINGS ";:color 7,w15.cb:print chr$(179)
color w15.bdr,w15.cb:print chr$(192);:color 7,w15.cb:print repeat$(14,chr$(196)) chr$(217)
color w15.bdr,w15.cb:print chr$(218) repeat$ (14,chr$(196));:color 7,w15.cb:print chr$(191)
color w15.bdr,w15.cb:print chr$(179);
color w15.cf
if set_op2%=5 then color w15.hf,w15.hb :if ky$=chr$(13) and mov%=0 and fload%=0 then ky$="":gosub sreset:gosub setdrive:goto rst1
print "PWM/GS2 DRIVE ";:color 7,w15.cb:print chr$(179)
color w15.bdr,w15.cb:print chr$(192);:color 7,w15.cb:print repeat$(14,chr$(196)) chr$(217)
view text (42,3)-(72,18)
color w15.bdr,w15.cb
print " REMAINING FREE MEMORY "
color w15.bdr,w15.cb:print chr$(218) repeat$ (28,chr$(196));:color 7,w15.cb:print chr$(191)
color w15.bdr,w15.cb:print chr$(179);
color w15.cf
print using " MEMORY ######### "; maxcon&;:color 7,w15.cb:print chr$(179)
color w15.bdr,w15.cb:print chr$(179);
color w15.cf
print using " EXPANDED MEM ########## "; maxems&;:color 7,w15.cb:print chr$(179)
color w15.bdr,w15.cb:print chr$(179);
color w15.cf
print using " PROGRAM LINES ####### "; maxlines&;:color 7,w15.cb:print chr$(179)
color w15.bdr,w15.cb:print chr$(192);:color 7,w15.cb:print repeat$(28,chr$(196)) chr$(217)
kcheck:
while not instat
gosub rpmdsp
gosub clkdsp
'if in_op%=0 and cancyc%=0 and estop%=0 and ll% then gosub vline:ll%=0
gosub autoread
if cancyc% and arun% and mov%=0 and in_op%=0 then gosub cancycle
loop
ky$=inkey$
'----------- added setup password check ---------
if ky$=chr$(13) and set_op2% > 0 then if password$ <> passkey$ then ky$=" "
if ky$=chr$(0,25) then
prompt$="ACCESS PASSWORD"
if password$=passkey$ then fill$=passkey$ else fill$=repeat$(len(password$),"*")
passkey$= gettext$ (fill$,prompt$,26,12,16,bycopy w10.cf,bycopy w10.cb)
goto rst1
end if
'------------------------
if ucase$(ky$)="X" then goto exitf
if ky$=chr$(0,72) and set_op2% > 0 then decr set_op2%
if ky$=chr$(0,80) and set_op2% < 5 then incr set_op2%
if ky$=chr$(0,75) and set_op2% > 2 then decr set_op2%,3
if ky$=chr$(0,77) and set_op2% < 3 then incr set_op2%,3
if ky$=chr$(0,133) or ky$=chr$(0,134) or ky$=chr$(0,84) or ky$=chr$(0,85) then gosub setmenu
if ky$=chr$(27) then gosub sreset
if ky$ > chr$(0,63) and ky$ < chr$(0,69) then screen 0,,0,0:return
if menu% then
if ky$ = chr$(0,59) then screen 0,,0,0:return
if ky$ > chr$(0,60) and ky$ < chr$(0,63) then screen 0,,0,0:return
else
gosub mankeys
end if
goto kyin
mankeys:
if ky$=chr$(0,59) then gosub setspndl
if ky$=chr$(0,60) then gosub setsdir
if ky$=chr$(0,61) then gosub setcool1
if ky$=chr$(0,62) then gosub setcool2
return
rpmdsp:
view text (44,9)-(62,12)
color w15.bdr,w15.cb
copyrpm??=rpmcntr??
if copyrpm?? > 49 then actrpm! = 491520 / copyrpm??
if tmr3?? = 65535 then actrpm!=0
'if actrpm! <> previousrpm! then
'actrpm!=(previousrpm! + actrpm!)/2
'previousrpm!=actrpm!
'end if
print using "RPM = ####.#"; actrpm!
print "GEAR = "gear?
print "COUNT = "revcnt??
'print tmr3??
return
function gettext$ (old$,msg$,lgth%,locx%,locy%,fg,bg)
shared ts%,doit%
newin$ = old$
noold:
view text (locx%,locy%)-(locx%+lgth%+2,locy%+3)
color fg,bg
print chr$(218) repeat$ (lgth%,chr$(196)) chr$(191)
print chr$(179) repeat$(lgth%,chr$(32)) chr$(179)
print chr$(192) repeat$(lgth%,chr$(196)) chr$(217);
doit%=0
gnkey:
while not instat
gosub clkdsp
if ts% <> ud% then gosub dspudtd
wend
ky$=inkey$
'ky$=ucase$(inkey$)
if ky$=chr$(0,71) then newin$="":decr ud%:goto noold
if ky$=chr$(13) then gettext$=newin$:doit% = 1:goto back
if ky$=chr$(27) then gettext$=old$:goto back
if ky$=chr$(8) then ky$="":if len(newin$) > 0 then newin$ = left$ (newin$,len(newin$)-1)
if ky$ > chr$(31) and ky$ < chr$(123) then if len(newin$) < lgth%-1 then newin$ = newin$+ky$
gosub dspudtd
goto gnkey
back:
view text (locx%,locy%)-(locx%+lgth%+2,locy%+3)
color fg,bg
cls
exit function
dspudtd:
ud% = ts%
if cn%=1 then cn%=0:cur$=" " else cn%=1:cur$="_"
view text (locx%+1,locy%)-(locx%+lgth%,locy%+2)
color fg,bg
'locate 1,1
print " "msg$
print newin$+cur$" ";
return
end function
'----------------- GS2 ac drive settings --------------
setdrive:
view text (1,2)-(80,23)
color w10.cf,w10.cb
cls
print
print " GS2 SERIES AC SPINDLE DRIVE CONTROLLER SETUP "
print " DEFAULT COM SETTINGS = ASCII 9600,7,N,2"
view text (48,3)-(80,6)
color w14.cf,w10.cb
print " ESC TO EXIT"
print " " chr$(24) chr$(25)" TO SELECT OPTION"
print " ENTER TO CHANGE VALUE"
gs2pram:
view text (5,6)-(27,10)
color w14.cf,w10.cb
color 0,w10.cb:print chr$(218) repeat$(1,chr$(196)) " GS2 COM SETTINGS " repeat$ (1,chr$(196));:color 7,w10.cb:print chr$(191)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " ENABLE DRIVE ";
if set_op5%=0 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
if gsdrive%=1 then
gsdrive%=0
gosub driveoff
else
gsdrive%=1
pwm?=0
comtmr1??=0
gosub driveon
end if
gosub bckdraw
gosub displaytool
screen 0,,2,2
goto gs2pram
end if
end if
if gsdrive%=0 then print " OFF "; else print " ON ";
color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " COM PORT ";
if set_op5%=1 then color w10.hf,w10.hb _
:if ky$=chr$(13) then ky$="":if comport1$="COM1" then comport1$="COM2" else comport1$="COM1":goto gs2pram
print " "comport1$ " ";
color 7,w10.cb:print chr$(179)
'color 0,w10.cb:print chr$(192);:color 7,w10.cb:print repeat$(20,chr$(196)) chr$(217);
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " BAUD RATE ";
if set_op5%=2 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
select case baud1$
case="4800" :baud1$="9600":goto gs2pram
case="9600" :baud1$="19200":goto gs2pram
case="19200":baud1$="38400":goto gs2pram
case="38400":baud1$="4800":goto gs2pram
end select
end if
end if
print using" \ \"; baud1$;
color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(192);:color 7,w10.cb:print repeat$(20,chr$(196)) chr$(217);
view text (5,11)-(33,19)
color w14.cf,w10.cb
color 0,w10.cb:print chr$(218) repeat$(4,chr$(196))" GS2 DRIVE LIMITS "repeat$(4,chr$(196));:color 7,w10.cb:print chr$(191)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " BASE FREQUENCY ";
if set_op5%=3 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
prompt$="BASE FREQUENCY OF MOTOR "
freqbase!=val(gettext$ (str$(freqbase!),prompt$,34,txth1%,txtv1%,bycopy w10.cf,bycopy w10.cb))
goto setdrive
end if
end if
print using"###.##hz ";freqbase!;:color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " MOTOR RPM AT BASE ";
if set_op5%=4 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
prompt$="RPM OF MOTOR AT BASE FREQ."
motor%=val(gettext$ (str$(motor%),prompt$,34,txth1%,txtv1%,bycopy w10.cf,bycopy w10.cb))
goto setdrive
end if
end if
print using"##### ";motor%;:color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " MAX FREQUENCY ";
if set_op5%=5 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
prompt$="Max frequency set on GS2 drive"
freqmax!=val(gettext$ (str$(freqmax!),prompt$,34,txth1%,txtv1%,bycopy w10.cf,bycopy w10.cb))
goto setdrive 'gs2pram
end if
end if
print using"###.##hz ";freqmax!;:color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " MIN FREQUENCY ";
if set_op5%=6 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
prompt$="Min frequency set on GS2 drive"
freqmin!=val(gettext$ (str$(freqmin!),prompt$,34,txth1%,txtv1%,bycopy w10.cf,bycopy w10.cb))
goto setdrive
end if
end if
print using"###.##hz ";freqmin!;:color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " MAX SPINDLE OVR % ";
if set_op5%=7 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
prompt$="MaxPercent of programmed S"
maxsovr%=val(gettext$ (str$(maxsovr%),prompt$,34,txth1%,txtv1%,bycopy w10.cf,bycopy w10.cb))
goto setdrive
end if
end if
print using" ###% ";maxsovr%;:color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " MIN SPINDLE OVR % ";
if set_op5%=8 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
prompt$="MinPercent of programmed S"
minsovr%=val(gettext$ (str$(minsovr%),prompt$,34,txth1%,txtv1%,bycopy w10.cf,bycopy w10.cb))
goto setdrive
end if
end if
print using" ###% ";minsovr%;:color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " SPINDLE INC/DEC % ";
if set_op5%=9 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
prompt$="Inc/Dec Percent of programmed S"
rpminc%=val(gettext$ (str$(rpminc%),prompt$,34,txth1%,txtv1%,bycopy w10.cf,bycopy w10.cb))
goto setdrive
end if
end if
print using" ###% ";rpminc%;:color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(192);:color 7,w10.cb:print repeat$(26,chr$(196)) chr$(217);
'-------------------------- PWM SETTING -------------------------------------------
view text (5,20)-(34,23)
color w14.cf,w10.cb
color 0,w10.cb:print chr$(218) repeat$(6,chr$(196))" PWM SETTINGS "repeat$(6,chr$(196));:color 7,w10.cb:print chr$(191)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " ENABLE PWM OUTPUT ";
if set_op5%=10 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
if pwm?=1 then
pwm?=0
else
pwm?=1
gsdrive%=0
gosub driveoff
end if
goto gs2pram
end if
end if
if pwm?=0 then print " OFF "; else print " ON ";
color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " RPM AT FULL PWM ";
if set_op5%=11 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
prompt$=" MOTOR RPM AT FULL PWM "
pwmrpm%=val(gettext$ (str$(pwmrpm%),prompt$,34,txth1%,txtv1%,bycopy w10.cf,bycopy w10.cb))
goto gs2pram
end if
end if
print using" ##### ";pwmrpm%;:color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(192);:color 7,w10.cb:print repeat$(26,chr$(196)) chr$(217);
'---------------------------------------------------------------------
'--- GS2 SET ADDRESS -----
view text (40,6)-(64,10)
color w14.cf,w10.cb
color 0,w10.cb:print chr$(218) repeat$(2,chr$(196))" SEND GS2 COMMAND "repeat$(2,chr$(196));:color 7,w10.cb:print chr$(191)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " ADDRESS (dec) ";
if set_op5%=12 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
prompt$=" ADDRESS (dec) "
pram_dec$ = gettext$ (pram_dec$,prompt$,34,txth1%,txtv1%,bycopy w10.cf,bycopy w10.cb)
pram_dec$ = right$ ("0000"+ pram_dec$,4)
goto gs2pram
end if
end if
print pram_dec$;:color w10.cf,w10.cb:print " ";
color 7,w10.cb:print chr$(179)
'--- GS2 SET DATA ------------
color 0,w10.cb :print chr$(179);
color w10.cf,w10.cb:print " DATA (decimal) ";
if set_op5%=13 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
prompt$=" DATA (dec) "
pram_dat$ = gettext$ (pram_dat$,prompt$,34,txth1%,txtv1%,bycopy w10.cf,bycopy w10.cb)
pram_dat$ = right$ ("0000" + pram_dat$,4)
goto gs2pram
end if
end if
print pram_dat$;:color w10.cf,w10.cb:print " ";
color 7,w10.cb:print chr$(179)
'---- GS2 WRITE DATA ------
color 0,w10.cb:print chr$(179);
if set_op5%=14 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
if gsdrive%=1 then
pram_low$= right$("00"+ hex$(val(right$(pram_dec$,2))),2)
pram_high$= right$("00"+ hex$(val(left$(pram_dec$,2))),2)
pram_address$ = pram_high$ + pram_low$
newdat$ = "0106"+ pram_address$ + right$("0000" + hex$(val(pram_dat$)),4)
gosub sendGS2
end if
goto gs2pram
end if
end if
print " WRITE ";:color w10.cf,w10.cb:print " ";
'---- READ GS2 DATA register ----
color 0,w10.cb:print chr$(179);
if set_op5%=15 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
if gsdrive%=1 then
pram_low$= right$("00"+ hex$(val(right$(pram_dec$,2))),2)
pram_high$= right$("00"+ hex$(val(left$(pram_dec$,2))),2)
pram_address$ = pram_high$ + pram_low$
newdat$ = "0103"+ pram_address$ + "0001"
temp_dat$=input$(loc(4),#4) '--- make sure the buffer is empty
gosub sendGS2
while comtmr1?? < comdelay% '--- wait for reply
wend
temp_dat$=input$(loc(4),#4) '--- read the reply from com port
pram_dat$= right$("0000"+ mid$(str$(val("&h" + mid$(temp_dat$,8,4))),2),4)
end if
goto gs2pram
end if
end if
print " READ ";:color w10.cf,w10.cb:print " ";
color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(192);:color 7,w10.cb:print repeat$(22,chr$(196)) chr$(217);
'----GEAR CHANGE SETUP ----------------------------------------------------
view text (40,11)-(68,23)
color w14.cf,w10.cb
color 0,w10.cb:print chr$(218) repeat$(6,chr$(196))" GEAR CHANGES "repeat$(6,chr$(196));:color 7,w10.cb:print chr$(191)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " NUMBER OF GEAR CHANGES ";
if set_op5%=16 then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
prompt$="Number of gear changes "
gearcount? = val(gettext$ (str$(gearcount?),prompt$,34,txth1%,txtv1%,bycopy w10.cf,bycopy w10.cb))
if gearcount? >8 then gearcount?=8
if gearcount? <1 then gearcount?=1
goto setdrive
end if
end if
print using"# ";gearcount?;:color 7,w10.cb:print chr$(179)
t?=0
while t? < gearcount?
incr t?
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " GEAR RATIO #" t?"= ";
if set_op5%=16+t? then
color w10.hf,w10.hb
if ky$=chr$(13) then
ky$=""
prompt$="RATIO OF SPINDLE/MOTOR FOR #"+str$(t?)+" "
ratio!(t?)=val(gettext$ (str$(ratio!(t?)),prompt$,34,txth1%,txtv1%,bycopy w10.cf,bycopy w10.cb))
goto setdrive
end if
end if
print using"##.#### ";ratio!(t?);:color 7,w10.cb:print chr$(179)
wend
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " MAX SPINDLE RPM =";
if pwm? then
maxs!=pwmrpm% * ratio!(gearcount?)
else
maxs!=freqmax!/freqbase! * motor% * ratio!(gearcount?)
end if
print using" ####.# ";maxs!;:color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(179);
color w10.cf,w10.cb:print " MIN SPINDLE RPM =";
if pwm? then
mins!=1
else
mins!=freqmin!/freqbase! * motor% * ratio!(1)
end if
print using" ####.# ";mins!;:color 7,w10.cb:print chr$(179)
color 0,w10.cb:print chr$(192);:color 7,w10.cb:print repeat$(26,chr$(196)) chr$(217);
while not instat
gosub clkdsp
loop
ky$=inkey$
if ky$=chr$(0,72) and set_op5% > 0 then decr set_op5%
if ky$=chr$(0,80) and set_op5% < 16 + gearcount? then incr set_op5%
if ky$=chr$(27) then gosub sreset:gosub saveall: return
goto gs2pram
return
'----------------------------------SCREEN COLOR --------------------
setcolor:
view text (1,2)-(80,23)
color 7,bgcolor%
cls
newc:
view text (2,2)-(79,4)
color 7,bgcolor%
if cselect%=0 then
if ky$=chr$(61) or ky$=chr$(43) or ky$=chr$(78) then
if pal%(cptr%) < 63 then incr pal%(cptr%):palette cptr%,pal%(cptr%)
end if
if ky$=chr$(45) or ky$=chr$(95) or ky$=chr$(74) then
if pal%(cptr%) > 0 then decr pal%(cptr%):palette cptr%,pal%(cptr%)
end if
print" ";
for t=0 to 15
if cptr% = t then print " "chr$(25)" "; else print " ";
next t
nuc%=pal%(cptr%)
print
print chr$(26)"PALETTE ";
else
print
print " PALETTE ";
end if
for t=0 to 15
color t,bgcolor%
print repeat$(4,chr$(219));
next t
print
color 7,bgcolor%
print " ";
for t=0 to 15
print using" ## "; t;
next t
lhl%=0
select case cpage%
case = 0:gosub colors1
case = 1:gosub colors2
case = 2:gosub colors3
end select
if cchange%=1 then cchange%=0:goto newc
view text (2,2)-(9,2)
color 7,bgcolor%
print "COLOR ";
print using"##";nuc%;
kyw1:
while not instat
gosub clkdsp
gosub selects
wend
ky$=inkey$
ex1:
if ky$=chr$(27) then
gosub bckdraw
gosub page1
gosub displaytool
screen 0,,2,2
return
end if
if ky$=chr$(0,77) then
if cselect%=0 and cptr% < 15 then incr cptr%
if cselect% > 0 then
incr cselect%,19
'if cselect% + 18 < maxsel% then incr cselect%,19
end if
end if
if ky$=chr$(0,75) then
if cselect%=0 and cptr% > 0 then decr cptr%
if cselect% > 0 then decr cselect%,19:if cselect% <1 then cselect%=1
'if cselect% > 19 then decr cselect%,19
end if
if ky$=chr$(0,80) then
if cpage%=0 then
if cselect% < maxsel% then incr cselect%
else
if cselect% < maxsel% then incr cselect%
end if
end if
if ky$=chr$(0,72) and cselect% > 0 then decr cselect%
if ky$=chr$(0,81) and cpage% < 2 then incr cpage%:goto setcolor
if ky$=chr$(0,73) and cpage% > 0 then decr cpage%:goto setcolor
if ucase$(ky$)="D" then gosub setdefaultcolor
goto newc
'---------------- reset default colors --------
setdefaultcolor:
gosub setpal
palette using pal%(0)
fgmain%=0
bgmain%=2
fgsetup%=0
bgsetup%=2
fgwork%=0
bgwork%=2
fgtool%=0
bgtool%=2
fgfile%=0
bgfile%=2
fgcolor%=0
bgcolor%=1
modecf%=13:modecb%=2
filecf%=12:filecb%=2
vercf%=15:vercb%=2
clkcf%=13:clkcb%=2
fksel%=3
cfsel%=7:cbsel%=1
cfhsel%=0:cbhsel%=5
cfhpic%=7:cbhpic%=4
w1.cf=12
w1.cb=2
w1.bdr=7
w2.cf=3
w2.cb=2
w2.bdr=7
w3.cf=0
w3.cb=3
w3.hf=15
w3.hb=7
w3.bdr=8
w4.cf=3
w4.cb=2
w4.bdr=7
w5.cf=0
w5.cb=5
w5.bdr=8
w6.cf=0
w6.cb=5
w6.bdr=8
w7.cf=0
w7.cb=5
w7.hf=13
w7.hb=2
w7.bdr=8
w8.cf=0
w8.cb=11
w8.hf=7
w8.hb=2
w8.bdr=8
w9.cf=0
w9.cb=5
w9.bdr=0
w10.cf=0
w10.cb=11
w10.hf=7
w10.hb=2
w10.bdr=0
w11.cf=0
w11.cb=1
w11.bdr=7
w12.cf=12
w12.cb=2
w12.hf=7
w12.hb=2
w12.bdr=7
w13.cf=3
w13.cb=2
w13.bdr=7
w14.cf=0
w14.cb=11
w14.hf=7
w14.hb=2
w14.bdr=0
w15.cf=0
w15.cb=5
w15.hf=7
w15.hb=2
w15.bdr=0
w16.cf=12
w16.cb=2
w17.cb=5
w17.bdr=8
w18.cf=0
w18.cb=5
w18.bdr=8
w19.cf=0
w19.cb=5
w19.bdr=8
w20.cf=3
w20.cb=2
w20.bdr=7
w21.cf=12
w21.cb=2
w21.bdr=7
w22.cf=3
w22.cb=2
w22.bdr=7
w23.cf=0
w23.cb=5
w23.bdr=8
return
'------------------------------------------
colors1:
maxsel%=30
if cselect% > maxsel% then cselect%=maxsel%
'---------------------- main screen colors --------
view text (2,5)-(39,23)
color 0,bgcolor%
print " MAIN RUN SCREEN COLORS "
print " " chr$(24) chr$(25)" OR "chr$(27) chr$(26) " TO SELECT"
print " +/- TO CHANGE VALUE"
print
'------------------ MAIN BACKGROUND
color fgmain%,bgmain%
incr lhl%
if cselect%=lhl% then
nuc%=bgmain%
bgmain% = nucolor% (nuc%,7)
color fgmain%,bgmain%
print chr$(26);
else
print" ";
end if
print"MAIN SCREEN BACKGROUND "
color fgmain%,bgmain%
incr lhl%
if cselect%=lhl% then
nuc%=fgmain%
fgmain% = nucolor% (nuc%,15)
color fgmain%,bgmain%
print chr$(26);
else
print" ";
end if
print"MAIN SCREEN FOREGROUND "
'------------------- position window colors -----
color w1.cf,w1.cb
incr lhl%
if cselect%=lhl% then
nuc%=w1.cb
w1.cb = nucolor% (nuc%,7)
print chr$(26);
else
print" ";
end if
print"POSITION WINDOW BACKGROUND "
color w1.cf,w1.cb
incr lhl%
if cselect%=lhl% then
nuc%=w1.cf
w1.cf = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"POSITION WINDOW FOREGROUND "
color w1.cf,w1.cb
incr lhl%
if cselect%=lhl% then
nuc%=w1.bdr
w1.bdr = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"POSITION WINDOW BORDER ";
color w1.bdr,w1.cb:print repeat$(4,chr$(205))
'-------------- dist window colors ---
color w2.cf,w2.cb
incr lhl%
if cselect%=lhl% then
nuc%=w2.cb
w2.cb = nucolor% (nuc%,7)
print chr$(26);
else
print" ";
end if
print"DIST WINDOW BACKGROUND "
color w2.cf,w2.cb
incr lhl%
if cselect%=lhl% then
nuc%=w2.cf
w2.cf = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"DIST WINDOW FOREGROUND "
color w2.cf,w2.cb
incr lhl%
if cselect%=lhl% then
nuc%=w2.bdr
w2.bdr = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"DIST WINDOW BORDER ";
color w2.bdr,w2.cb:print repeat$(4,chr$(205))
'-------------- tool window colors ---
color w4.cf,w4.cb
incr lhl%
if cselect%=lhl% then
nuc%=w4.cb
w4.cb = nucolor% (nuc%,7)
print chr$(26);
else
print" ";
end if
print"TOOL WINDOW BACKGROUND "
color w4.cf,w4.cb
incr lhl%
if cselect%=lhl% then
nuc%=w4.cf
w4.cf = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"TOOL WINDOW FOREGROUND "
color w4.cf,w4.cb
incr lhl%
if cselect%=lhl% then
nuc%=w4.bdr
w4.bdr = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"TOOL WINDOW BORDER ";
color w4.bdr,w4.cb:print repeat$(4,chr$(205))
'-------------- file run window colors ---
color w3.cf,w3.cb
incr lhl%
if cselect%=lhl% then
nuc%=w3.cb
w3.cb = nucolor% (nuc%,7)
print chr$(26);
else
print" ";
end if
print"RUN FILE WINDOW BACKGROUND "
color w3.cf,w3.cb
incr lhl%
if cselect%=lhl% then
nuc%=w3.cf
w3.cf = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"RUN FILE WINDOW FOREGROUND "
color w3.cf,w3.cb
incr lhl%
if cselect%=lhl% then
nuc%=w3.bdr
w3.bdr = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"RUN FILE WINDOW BORDER ";
color w3.bdr,w3.cb:print repeat$(4,chr$(205))
color w3.hf,w3.cb
incr lhl%
if cselect%=lhl% then
nuc%=w3.hf
w3.hf = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"RUN FILE HILITE FOREGROUND ";
'---------------------------------------------------------------------------
view text (40,5)-(79,23)
color w3.cf,w3.hb
incr lhl%
if cselect%=lhl% then
nuc%=w3.hb
w3.hb = nucolor% (nuc%,7)
print chr$(26);
else
print" ";
end if
print"FILE EDIT CURSOR BACKGROUND "
'-------------- command/GS drive window colors ---
color w18.cf,w18.cb
incr lhl%
if cselect%=lhl% then
nuc%=w18.cb
w18.cb = nucolor% (nuc%,7)
w19.cb = w18.cb
print chr$(26);
else
print" ";
end if
print"CMD/GS2 WINDOW BACKGROUND "
color w18.cf,w18.cb
incr lhl%
if cselect%=lhl% then
nuc%=w18.cf
w18.cf = nucolor% (nuc%,15)
w19.cf = w18.cf
print chr$(26);
else
print" ";
end if
print"CMD/GS2 WINDOW FOREGROUND "
color w18.cf,w18.cb
incr lhl%
if cselect%=lhl% then
nuc%=w18.bdr
w18.bdr = nucolor% (nuc%,15)
w19.bdr = w18.bdr
print chr$(26);
else
print" ";
end if
print"CMD/GS2 WINDOW BORDER ";
color w18.bdr,w18.cb:print repeat$(4,chr$(205))
'-------------- MSG window colors ---
color w6.cf,w6.cb
incr lhl%
if cselect%=lhl% then
nuc%=w6.cb
w6.cb = nucolor% (nuc%,7)
print chr$(26);
else
print" ";
end if
print"MSG WINDOW BACKGROUND "
color w6.cf,w6.cb
incr lhl%
if cselect%=lhl% then
nuc%=w6.cf
w6.cf = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"MSG WINDOW FOREGROUND "
color w6.cf,w6.cb
incr lhl%
if cselect%=lhl% then
nuc%=w6.bdr
w6.bdr = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"MSG WINDOW BORDER ";
color w6.bdr,w6.cb:print repeat$(4,chr$(205))
'-------------- AXIS HOME window colors ---
color w16.cf,w16.cb
incr lhl%
if cselect%=lhl% then
nuc%=w16.cb
w16.cb = nucolor% (nuc%,7)
print chr$(26);
else
print" ";
end if
print"HOME WINDOW BACKGROUND "
color w16.cf,w16.cb
incr lhl%
if cselect%=lhl% then
nuc%=w16.cf
w16.cf = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"HOME WINDOW FOREGROUND "
'-------------- G code window colors ---
color w5.cf,w5.cb
incr lhl%
if cselect%=lhl% then
nuc%=w5.cb
w5.cb = nucolor% (nuc%,7)
print chr$(26);
else
print" ";
end if
print"G CODE WINDOW BACKGROUND "
color w5.cf,w5.cb
incr lhl%
if cselect%=lhl% then
nuc%=w5.cf
w5.cf = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"G CODE WINDOW FOREGROUND "
color w5.cf,w5.cb
incr lhl%
if cselect%=lhl% then
nuc%=w5.bdr
w5.bdr = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"G CODE WINDOW BORDER ";
color w5.bdr,w5.cb:print repeat$(4,chr$(205))
'-------------- M code window colors ---
color w17.cf,w17.cb
incr lhl%
if cselect%=lhl% then
nuc%=w17.cb
w17.cb = nucolor% (nuc%,7)
print chr$(26);
else
print" ";
end if
print"M CODE WINDOW BACKGROUND "
color w17.cf,w17.cb
incr lhl%
if cselect%=lhl% then
nuc%=w17.cf
w17.cf = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"M CODE WINDOW FOREGROUND "
color w17.cf,w17.cb
incr lhl%
if cselect%=lhl% then
nuc%=w17.bdr
w17.bdr = nucolor% (nuc%,15)
print chr$(26);
else
print" ";
end if
print"M CODE WINDOW BORDER ";
color w17.bdr,w17.cb:print repeat$(4,chr$(205))
color 0,bgcolor%
print
print " PAGE DOWN FOR MORE "
return
'-----------------------------------COLOR page 2 ------------------------
colors2:
'-----------------------TOOL OFFSET BACKGROUND
maxsel%=35
if cselect% > maxsel% then cselect%=maxsel%
view text (2,5)-(39,23)
color 0,bgcolor%
print " TOOL,WORK & FILE SCREEN COLORS"
print " " chr$(24) chr$(25)" OR "chr$(27) chr$(26) " TO SELECT"
print " +/- TO CHANGE VALUE"
'print
'--------------------------------
color fgtool%,bgtool%
incr lhl%
if cselect%=lhl% then
nuc%=bgtool%
bgtool% = nucolor% (nuc%,7)
color fgtool%,bgtool%
print chr$(26);
else
print" ";
end if
print"TOOL OFFSET BACKGROUND "
color fgtool%,bgtool%
incr lhl%
if cselect%=lhl% then
nuc%=fgtool%
fgtool% = nucolor% (nuc%,15)
color fgtool%,bgtool%
print chr$(26);
else