// "FIXOPS" (REVISED) WILL GUIDE YOU THROUGH BUILDING OR REPAIRING AN OPS CENTRAL GRID // JUST TYPE 'FIXOPS' INTO THE SCRIPT COMMAND PROMPT DIALOG TO RUN THIS SUBROUTINE // ENSURE OPS CENTRAL AND SCHEDULE ARE BOTH HIDDEN AT START call $view(hide,ops) call $view(hide,schedule) // DEFINE CR CHARACTER FOR USE IN DISPLAY NOTES. let cr=" " // SET UP THE NOTEBOX WINDOW SIZE AND POSITION, DISPLAY FIRST INSTRUCTION // Display Please Wait Notebox set noteboxrect "24,20,299,740" notebox color=255,192,0 notebox FIXOPS WILL CREATE OR VALIDATE YOUR OPS CENTRAL DATA // SET UP THE NOTE WINDOW SIZE AND POSITION. call noteprops 53 720 20 71 1 L // SET NOTE COLOR note color=220,220,220 // PREVENT ESC FROM CLOSING THE NOTE WINDOW set notedownonesc 0 // DISPLAY OPENING NOTE note " ABOUT THE FIXOPS SUBROUTINE 'FixOps' will check all the data in your Ops Central Grid and generate any missing data. Layouts with existing Advanced Ops data will be rewound prior to checking. Layouts without ops data require labeled locations with cars occupying the Locations. You can save the layout at any time and use 'FixOps' again to complete the job later. Press F1 key to continue. ....or press ESC key twice to terminate the FixOps process. " // WAIT FOR F1 KEY TO PROCEED // allow ESC key to clear note window on this first occassion of the note // this permitS ESC ESC to clear the note and cancel the script while waiting for F1 key. // ESC1 closes the note and ESC2 cancels active script. set notedownonesc 1 on key 112 set notedownonesc 0 // Display "Please Wait" Notebox notebox Checking Layout Design and Location Data - Please Wait // IF NO CARS EXIST ON LAYOUT THEN ABORT PROCESS if ($layout(idset,carIDs)="") note @cr @cr@FIX OPS ABORTED - THERE ARE NO CARS ON THIS LAYOUT@cr @cr after 0:0:08 note notebox exit endif // LAYOUT - GET DETAILS OF EXISTING TRACKLABELS (IF ANY) let tracklabels = $layout(idset,tracklabels) let tracklabels = $set(@tracklabels,sort) let tracklabels = $set(@tracklabels,dedupe) // IF NO TRACKLABELS EXIST THEN ABORT PROCESS if (tracklabels = "") note @cr @cr@FIX OPS ABORTED - LAYOUT HAS NO LABELED LOCATIONS@cr @cr after 0:0:08 note notebox exit endif // INITIALIZE ANY EXISTING TRACK AND CAR SETS call $ao_dev(init) // INITIATE MESSAGE VARIABLE TO BUILD DATA FOR NOTE WINDOW let message = "BASIC LAYOUT DESIGN CHECKS @cr@" note @message // CHECK FOR AN EXISTING AO SET-UP = CHECK FOR A READY CALCULATED PICKUPLIST SET // IF FOUND DISPLAY PROGRESS NOTE, REWIND TRAINS AND RESET FOR FIRST SWITCHLIST if ($ao_dev(getset,cpickuplist)<>"") let test = $ops(nswitchlistno) if (test > 1) let message = @message + "> Layout = $layout @cr@> Resetting Ops sequence to Switchlist 1 for testing. @cr@" note @message call $ao_dev(dev,Reset trains to start) call $ao_dev(dev,Generate First Switchlist) endif else let message = @message +"> Layout = $layout @cr@> This layout has not yet been prepared for Ops.@cr@" note @message endif // ================================================================================ // LAYOUT INTEGRITY TESTS // APPLY TILDE TO UNLABELED TRACKS, ADD # PREFIX TO NUMERIC LABELS, // REMOVE INVALID SPACES FROM LABELS let tracks = $layout(idset,trackIDs) let temptracks = @tracks // check label syntax on all tracks. while (temptracks<>"") let X = $set(@temptracks,get,0) let temptracks = $set(@temptracks,remove,0) let Y = $track(@X,label) // if the track label field is null apply a Tilde character if (Y="") let $track(@x,label)="~" endif // if the track label field is purely numeric then apply a # prefix to make it alpha-numeric if (Y - @Y = 0) let $track(@x,label) = "#" + @Y endif // if the track label field contains a space then remove it if ($string(@Y,contains," ")=1) let Pos = $findstr(" ",@Y) let Y1 = $substr(0,@pos,@Y) let pos = @pos+1 let Y2 = $substr(@pos,0,@Y) let Y = @Y1+@Y2 let $track(@x,label) = @Y endif endwhile // Update message and note. let message = @message + "> Validated existing Track Labels and Car positioning data. @cr" note @message // REINITIALIZE OPS TO TAKE ACCOUNT OF TRACK LABEL CHANGES call $ao_dev(init) // LAYOUT - CHECK FOR AT LEAST ONE ENGINE let cenginesplus = $ao_dev(getset,cenginesplus) if (cenginesplus = "") let message= @message + "> No engines found. Please add at least one Engine to this layout. @cr" note "@message @cr Press the F1 key when this has been done. @cr" on key 112 call $ao_dev(init) endif // APPLY AN XO FLAG TO ALL ENGINES, TENDERS, CABOOSES AND PASSENGER CARS call $ao_dev(dev,"flag XO") // Update message and note. let message = @message + "> Engines, Tenders, Cabooses and Passenger Cars flagged as XO. @cr" note @message // CHECK ALL CARS FOR XO RESERVED BLOCK TRAIN AND PASSENGER TRAIN DATA // ONLY DO THIS IF THERE IS NO EXISTING OPS LAYER ON THE LAYOUT (No Switchlist) let control = $ops(find,seq.startat,all,startat) if (control = "") // ------------------------ let waitmessage = "@cr@Testing for inherited XO Block Trains - Please Wait.@cr" note @message // ------------------------ let Broute = "" let Bloadat = "" let Bshipment = "" let Bstart ="" let Proute = "" let Ploadat = "" let Pshipment = "" let blockvisit = "" let blockstart = "" let passvisits = "" let passstart = "" let morexo = "" let tempcars = $ao_dev(getset,cALL) while (tempcars<>"") let car = $string(@tempcars,nexttoken,",") let thisaar = $car(@car,aar) // test for XO spacer cars, add XO flag if found let test = $car(@car,route) if (test = "spacer") // put an XO flag onto the car let $car(@car,excludeops) = "X" endif // ignore info coming from Engines, Tenders or Cabooses, but permit EP let testset = @cenginesplus let EPcars = $ops(find,cars.aar,"EP",car) if (thisaar = "EP") let testset = $set(@cenginesplus,difference,@EPcars) endif if ($set(@testset,contains,@car) = 1) continue endif // extract carset cars containing block train and passenger train data let foundroute = $car(@car,route) // if route found then do the following if (foundroute <> "") // put an XO flag onto the car let $car(@car,excludeops) = "X" // strip out the ]] markers from routed cars let foundroute = $set(@foundroute,difference,"]]") let Baar = $set(@thisaar,difference,"P,PA,PAS,PB,PBC,PBO,PC,PL,PO,PS,PSA,EP") let Paar = $set(@thisaar,intersection,"P,PA,PAS,PB,PBC,PBO,PC,PL,PO,PS,PSA,EP") // find the block trains if (Baar <> "") let BR = $car(@car,route) let BL = $car(@car,loadat) let BS = $car(@car,shipment) let Bstart = $car(@car,tracklabel) let Broute = $set(@foundroute,union,@BR) let Broute = $set(@Broute,difference,"]]") let Bloadat = $set(@Bloadat,union,@BL) let Bshipment = $set(@Bshipment,union,@BS) let blockstart = $set(@blockstart,union,@Bstart) let blockvisit = $set(@blockvisit,union,@Broute) let blockvisit = $set(@blockvisit,difference,"]]") elseif (Paar <> "") // find the passenger trains //passenger cars are already XO so don't need flagging let PR = $car(@car,route) let PL = $car(@car,loadat) let PS = $car(@car,shipment) let Proute = $set(@foundroute,union,@PR) let Proute = $set(@Proute,difference,"]]") let Ploadat = $set(@Ploadat,union,@PL) let Pshipment = $set(@Pshipment,union,@PS) let passvisits = $set(@passvisits,union,@Proute) let passvisits = $set(@passvisits,difference,"]]") else // use same loop to identify additional cars requiring XO flags. // hack to apply an xo flag to postal cars and other special XO car types if ($string(@car,startswith,"MA")=1) let $car(@car,excludeops) = "X" let morexo = $set(@morexo,add,@car) elseif ($string(@car,startswith,"MB")=1) let $car(@car,excludeops) = "X" let morexo = $set(@morexo,add,@car) elseif ($string(@car,startswith,"MR")=1) let $car(@car,excludeops) = "X" let morexo = $set(@morexo,add,@car) elseif ($string(@car,startswith,"MW")=1) let $car(@car,excludeops) = "X" let morexo = $set(@morexo,add,@car) elseif ($string(@car,startswith,"D")=1) let $car(@car,excludeops) = "X" let morexo = $set(@morexo,add,@car) endif endif endif endwhile if (morexo <> "") // Update message and note. let message = @message + "> Car(s) @morexo also flagged as XO. @cr" note @message endif endif // LAYOUT - REINITIALIZE EXISTING TRACK SETS, CAR SETS AND VARIABLES call $ao_dev(reset) // LAYOUT - REMOVE ANY MISPLACED CARS WHICH ARE OBSTRUCTING RUNNING TRACKS // Identify any misplaced cars that are occuping unlabeled (~) tracks. let found = $track("~",occupiedby) if (found<>"") let found = $set(@found,sort) while ($track("~",occupiedby)<>"") let tempcars = $track("~",occupiedby) let xcar = $string(@tempcars,nexttoken) train @xcar;train car @xcar;train car delete car endwhile // Update message and note. let message = @message + "> Removed misplaced cars @found from unlabeled running tracks. @cr" let waitmessage = "@cr@Building Locations Grid - Please Wait.@cr" note @message @waitmessage endif // PAUSE BEFORE STARTING NEW MESSAGE FOR LOCATIONS let savedmessage = @message + @cr after 0:0:03 // ================================================================================ // LOCATIONS GRID CHECKS // UPDATE MESSAGE AND NOTE. let message = "LOCATIONS GRID CHECKS@cr@" note @message // DISPLAY "PLEASE WAIT" NOTEBOX notebox Updating Locations Grid - Please Wait // DISPLAY ANY OUTSTANDING MESSAGES FOR BLOCK TRAINS OR PASSENGER TRAINS let Btest = $set(@blockvisit,intersection,@tracklabels) if (Btest <> "") let message = @message + "> Locations @blockvisit identified for a Block train. @cr" note @message endif let Ptest = $set(@Proute,intersection,@tracklabels) if (Ptest <> "") let passvisits = $set(@passvisits,union,@Proute) let message = @message + "> Locations @passvisits identified for a Passenger train. @cr" note @message endif // ENSURE ANY PREVIOUSLY UNCLASSED ROW ENTRIES ARE DEFINED AS INDUSTRIES WITH ONE VACANT SPOT let classes = $ops(find,loc.track,all,id) let modified = "" while ($set(@classes,count)>0) let query = $set(@classes,get,0) let classes = $set(@classes,remove,0) // only change this entry if the class column is currently empty. let contents = $ops(get,loc.class,@query) if (contents = "") call $ops(set,loc.class,@query,"Industry") call $ops(set,loc.vacantspots,@query,1) let modified = $set(@modified,add,@query) endif endwhile if (modified <> "") let message = @message + "> Class data inserted for Row(s) @modified@.@cr@" note @message let modified = "" endif // these initial settings will be modified as the subroutine progresses // CLASS COLUMN MUST CONTAIN AT LEAST ONE INDUSTRY // this is true only in 99.9% of cases, it is feasible to have a totally XO ops layout with no industries grid. let tInds = $ops(find,loc.class,"industry",track) if (tinds="") // Update message and note. let message = @message + "> Layout has no Industries to generate inbound and outbound traffic.@cr@" note @message endif // CHECK FOR INDUSTRIES call $ao_dev(reset) let Set1 = $ao_dev(getset,tinds) let Set2 = $ao_dev(getset,tall) if (Set1<>"") if ($set(@Set2,equalsets,@Set1)=1) // Update message and note. let message = @message + "> Staging required. Location rows can't all be Industries.@cr@" note @message endif endif // CLASS TYPE MUST BE ONE OF THE VALID TYPES // It should now be impossible to enter an invalid class name so we shouldn't see this. let classtypes = "Staging,Interchange,Class Yard,Industry,XO reserved,sound only" let found = $ops(find,locations.class,all,class) let found = $set(@found,dedupe) let found = $set(@found,difference,@classtypes) // temporarily reset the class of any omitted or mistyped classtypes as Industry. if (found<>"") let tempclass = @found while (tempclass<>"") let x = $string(@found,nexttoken,",") let rowID = $ops(find,loc.track,@x) call $ops(set,loc.class,@rowID,"industry") // Update message and note. let message = @message + "> Invalid Class Type for location(s) @found reset to 'Industry'.@cr@" note @message endif // IF THERE IS NO STAGING OR INTERCHANGE THEN CREATE AN INITIAL STAGING YARD let Set = "Staging,Interchange" let data = $ops(find,loc.class,all,class) let data = $set(@data,intersection,@Set) if (data="") // Update message and note. let message = @message + "> Layout needs at least one Staging Yard or Interchange.@cr@" note @message // find the track label with the biggest capacity to use as Staging. let temptracks = $ops(find,loc.track,all,track) let x = $string(@temptracks,nexttoken,",") let y = @x while (temptracks<>"") let x = $string(@temptracks,nexttoken,",") if ($capac(@x,all)>$capac(@y,all)) let y=@x endif endwhile let rowID = $ops(find,loc.track,@y) call $ops(set,loc.class,@rowID,"staging") // Update message and note. let message = @message + "> Location @y was classified as Staging.@cr@" note @message endif // SELECT ANY ADDITIONAL TRACK LABELS SUITABLE FOR USE AS STAGING OR INTERCHANGES // Any tracklabel which contains a mix of XO and non XO cars at the start of Switchlist 1 must be Staging. // Start with a list of all tracklabels on the Locations tab let setTstaging = $ops(find,locations.class,"staging",track) let set1 = $ops(find,locations.track,all,track) let set1 = $set(@set1,sort) let temptracks = @set1 let x = "" while temptracks <> "" // update set of staging tracks from grid. let x = $string(@temptracks,nexttoken,",") // get list of cars occupying each track let occby = $track(@x,occupiedby) // eliminate tracks with no cars if (occby="") continue endif // eliminate tracks with less than 8 cars -- Staging requires a stock of cars. if ($set(@occby,count)<8) continue endif // eliminate tracks which have no non xo cars let cxocars = $ao_dev(getset,cxo) let test = $set(@occby,difference,@cxocars) if (test = "") continue endif // eliminate tracks without an engine // engine not essential for staging but tracks without engine could be interchange or class yard let y = $set(@cenginesplus,intersection,@occby) if (y="") continue endif // eliminate tracks already labeled as Class Yards let tyards = $ops(find,loc.class,"class yard",track) if ($set(@x,intersection,@Tyards)<>"") continue endif // eliminate tracks already labeled as XO reserved. if ($set(@x,intersection,@setTxo)<>"") continue endif // eliminate tracks already labeled as Staging if ($set(@x,intersection,@setTstaging)<>"") continue endif // eliminate tracks labeled as sound only let setTsound = $ops(find,locations.class,"sound only",track) if ($set(@x,intersection,@setTsound)<>"") continue endif // if we get this far then we can safely reclassify the track as staging. let rowID = $ops(find,loc.track,@x) call $ops(set,loc.class,@rowID,"staging") // Update message and note. let message = @message + "> Location @x was reclassified as Staging.@cr@" note @message endwhile // IDENTIFY AND CLASSIFY XO RESERVED TRACKS // Identify The rows whose track labels are populated ONLY by XO cars // Tracks containing only XO cars (and no standard cars) should be labeled as XO reserved. let setCxo = $ao_dev(getset,cXO) // XO cars let setCnonxo = $ao_dev(getset,cALL) // All cars let setCnonxo = $set(@setCnonxo,difference,@setCxo) // Non XO cars let setTxo = $ops(find,locations.class,"xo reserved",track) // Existing XO reserved tracks let setindustries = $ops(find,industries.industry,all,industry) let setindustries = $set(@setindustries,dedupe) // Make a set of the track labels containing only XO cars let tempcars = @setCxo let tempcars = $set(@tempcars,dedupe) let tempcars = $set(@tempcars,sort) while (tempcars<>"") let setTxo = $ops(find,locations.class,"xo reserved",track) // Update set of XO reserved tracks let x = $string(@tempcars,nexttoken,",") let y = $car(@x,track) let y = $track(@y,label) let z = $track(@y,occupiedby) // skip any tracks which also contain non xo cars let z = $set(@setCnonxo,intersection,@z) if ($set(@z,count)>0) continue endif // skip any tracks already designated as XO reserved if ($set(@setTxo,contains,@y)=1) continue endif // update the Locations grid to show the track id as XO reserved. let rowID = $ops(find,loc.track,@y) call $ops(set,loc.class,@rowID,"XO reserved") // Update message and note. let message = @message + "> Location @y was classified as XO reserved.@cr@" let waitmessage = "@cr@Building Locations Grid - Please Wait.@cr" note @message @waitmessage endwhile // GET THE KEY XO CAR DATA (all xo, revenue xo, pass xo, freight xo) let xoallcars = $ao_dev(getset,cxo) let xorevcars = $set(@xoallcars,difference,@cenginesplus) let xopasscars = "" let xotempcars = @xorevcars while (xotempcars <> "") let xcar = $string(@xotempcars,nexttoken,",") let xaar = $car(@xcar,aar) if ($set(@xaar,intersection,"P,PA,PAS,PB,PBC,PBO,PC,PL,PO,PS,PSA,EP")<>"") let xopasscars = $set(@xopasscars,add,@xcar) let xorevcars = $set(@xorevcars,difference,@xcar) endif endwhile // update passcar info to include EP powered cars (needed by pass train generator) let xopasscars = $set(@xopasscars,union,@EPcars) let xofreightcars = $set(@xorevcars,difference,@xopasscars) // no report needed here, infor just collected into two variables. xofreightcars and xopasscars // LOCATION NAME MUST NOT BE EMPTY - FIX IT TEMPORARILY BY APPLYING THE TRACK LABEL. let found = $ops(find,locations.location,"",track) let foundID = $ops(find,locations.location,"",id) if (found<>"") let tempid = @foundID // Replace any blank location names with the track label as a temporary fix. while (tempid<>"") let X = $string(@tempid,nexttoken,",") let Y = $ops(get,locations.track,@X,track) call $ops(set,locations.location,@X,@Y) endwhile endif // LOCATION NAME SHOULD NOT BE SAME AS TRACK LABEL. // layout will still function if this is not done but proper Location names are preferred let Set1 = $ops(find,locations.track,all,track) let Set2 = $ops(find,locations.location,all,location) // Find rows which still require a location name. let Set3 = $set(@Set1,intersection,@Set2) if (Set3<>"") // Update message and note. let message = @message + "> Location name(s) required for track(s) @Set3@.@cr@" note @message endif // TRACK LABEL MUST EXIST. CHECK FOR NON EXISTENT TRACK LABEL. // it should now be impossible to get into this situation as robust checks are included in the data entry. let tAll = $ao_dev(getset,tall) let found = $ops(find,locations.track,all,track) let found = $set(@found,dedupe) let found = $set(@found,difference,@tall) let templist = @found while (templist<>"") let X = $set(@templist,get,0) let templist = $set(@templist,remove,0) let row = $ops(find,locations.track,@X,id) if found<>"") // Update message and note. let message = @message + "> Row @row has an invalid Location label @X@.@cr@" note @message endif endwhile // ADJUST THE EXISTING VACANT SPOT DATA FOR INDUSTRIES IF NECESSARY // overcomes problems in switchlist robot where some AO layouts get stuck for lack of space. let Set1 = "" // Tracks with insufficient vacant spots. let Set2 = "" // Tracks with surplus vacant spots. // Get the list of available Industries. let temp = $ops(find,locations.class,industry,track) while ($set(@temp,count)>0) let found = $string(@temp,nexttoken,",") let rowID = $ops(find,location.track,@found) // restrict check to industries with a vacant spots value of 1 (ignoring those changed by user) let spotsvalue = $ops(get,locations.vacantspots,@rowid) if (spotsvalue <> 1) continue endif // make the changes if ($capac(@found,free)<1.3) // but only if the track is populated if ($track(@found,occupiedby)>0) let set1 = $set(@set1,add,@found) endif endif if ($capac(@found,free)>3) let set2 = $set(@set2,add,@found) endif endwhile // report changes if any were made if ($set(@set1,count)>0) // Update message and note. let message = @message + "> Vacant Spots value reduced to 0 at Location(s) @set1@.@cr@" note @message let temp = @set1 while ($set(@temp,count)>0) let x = $string(@temp,nexttoken,",") let rowID = $ops(find,location.track,@x) call $ops(set,location.vacantspots,@rowID,"0") endwhile endif if ($set(@set2,count)>0) // Update message and note. let message = @message + "> Vacant Spots value increased to 2 at Location(s) @set2@.@cr@" note @message let temp = @set2 while ($set(@temp,count)>0) let x = $string(@temp,nexttoken,",") let rowID = $ops(find,location.track,@x) call $ops(set,location.vacantspots,@rowID,"2") endwhile endif // IF VIAIN/VIAOUT ENTRIES EXIST IN INDUSTRIES GRID THEN LOCATION MUST BE A CLASS YARD if ($ops(find,industries.location,all)<>"") // Track labels used in the ViaIn and ViaOut columns of the Industry grid must be a Class Yard. let viainlabels = $ops(find,industries.viain,all,viain) let viaoutlabels = $ops(find,industries.viaout,all,viaout) let setYards = $set(@viainlabels,union,@viaoutlabels) let setYards = $set(@setYards,flatten) let setYards = $set(@setYards,sort) let setYards = $set(@setyards,dedupe) let setYards = $set(@setyards,difference," ") let setYards = $set(@setYards,difference,"~") let x = $ops(find,locations.class,"class yard",track) Let setYards = $set(@setYards,difference,@x) if (setYards<>"") let temp = @setYards while (temp<>"") let x = $string(@temp,nexttoken,",") let rowID = $ops(find,location.track,@x) call $ops(set,location.class,@rowID,"class yard") endwhile // Update message and note. let message = @message + "> Reclassified Location(s) @setYards as ClassYard.@cr@" note @message endif endif // IDENTIFY UNOCCUPIED INDUSTRY TRACKS THAT MAY NEED TO BE XO RESERVED. // These tracks could possibly be intended to be Passenger Stations or temporary storage tracks. // get the list of industries from the Locations grid. let locfound = $ops(find,loc.class,"industry",track) let locfound = $set(@locfound,dedupe) let locfound = $set(@locfound,sort) // get the list of industries from the Industries grid. let indfound = $ops(find,ind.industry,all,industry) let indfound = $set(@indfound,dedupe) let indfound = $set(@indfound,sort) // filter out those already existing in the Industries grid. let locfound = $set(@locfound,difference,@indfound) // reduce the list to eliminate tracks occupied by any cars. if ($set(@locfound,count)>0) let temp = @locfound while (temp<>"") let x = $string(@temp,nexttoken,",") // if track capacity exceeds freespace then track is occupied so skip if ($capac(@x,all)>$capac(@x,free)) continue endif // if unoccupied suggest possibility that track may be intended as XO Reserved // however it could still be a vacant industry track so leave decision to user let rowID = $ops(find,location.track,@x) // call $ops(set,location.class,@rowID,"XO reserved") // original autofix removed. // Update message and note. let message = @message + "> Industry @x has no cars to generate traffic (Should be OK, car order will be generated.).@cr@" note @message endwhile endif // ENTER DATA FOR THE VIACLASSYARD COLUMN // find the existing class yard definitions. // if we have an existing entry in the viaclassyard column we will not change it // if there is exactly 1 class yard then we will route cars to all industries through that class yard by default // if the number of class yards are greater than or less than one put a tilde in the grid to enable user to edit. let viayard = $ops(find,location.class,"class yard",track) let countyards = $set(@viayard,count) if (countyards<>1) let viayard = "~" endif // find the industry row definitions let rowsind = $ops(find,location.class,"industry",id) // if the field is empty put the via yard label (or tilde) into the grid let temp = @rowsind while (temp<>"") let thisrow = $string(@temp,nexttoken,",") let xvia = $ops(get,locations.viaclassyard,@thisrow) // in case data has been b/f only do this if the field is currently null if (xvia = "") call $ops(set,locations.viaclassyard,@thisrow,@viayard) endif if (xvia = "~") call $ops(set,locations.viaclassyard,@thisrow,@viayard) let revamp = "" // if we are changing the viaclassyard column from a tilde to a label this is a revamp requiring a new sequence grid let Rtest = $set(@viayard,intersection,"~") let revamp = "" if (Rtest <> "~") let revamp = @viayard endif endif endwhile // UPDATE NOTEBOX notebox Edit the Locations grid if necessary before continuing the FixOps process. // UPDATE SAVEDMESSAGE BEFORE SUGGESTING EDIT let savedmessage = @savedmessage + @message + @cr // OPEN LOCATIONS GRID FOR EDIT call $ops(show,lo) // PERMIT USER TO EDIT LOCATION NAMES AND CHANGE CLASS COLUMN ENTRIES // Update message and note. let message = @message + @cr + "YOU CAN EDIT THE LOCATIONS GRID IF NECESSARY (OPTIONAL)@cr@" let message = @message + "> You can change the Location Names if you wish.@cr@" let message = @message + "> Identify optional Class Yard or Interchanges if needed.@cr@" let message = @message + "> Change any ViaClassYard labels to clarify the required car routing.@cr@" let message = @message + "> Select Sounds if needed for specified Locations (e.g. Crossing Bells).@cr@" note @message // GET USER INPUT call $msgbox("Optionally Edit the Locations grid and apply the changes. Then click OK here to continue the FixOps process.") call $ops(hide,ops) // REFRESH VIEW AND OPS VARIABLE call $ops(reset) view refresh // ================================================================================ // INDUSTRIES GRID CHECKS let waitmessage = "@cr@Building Industries Grid - Please Wait.@cr" // start a new message and note let message = "INDUSTRIES GRID CHECKS @cr@" note @message @waitmessage // set up catch all waitmessage for future pauses let waitmessage = "@cr@Calculating... - Please Wait.@cr" // DISPLAY A "PLEASE WAIT" NOTEBOX notebox Updating Industries Grid - Please Wait // IF THE INDUSTRIES GRID DATA DOESN'T EXIST THEN CREATE IT NOW FROM THE PREPLACED CARS // test for the existence of an Industries grid. let indfound = $ops(find,ind.industry,all,industry) let indfound = $set(@indfound,dedupe) let indfound = $set(@indfound,sort) // if the Industries grid does not exist then create a new one. if (indfound="") // update message and note let message = @message + "> New grid built from cars positioned at the Locations.@cr@" note @message @waitmessage call $ao_dev(dev,Build Industries Grid) // BIGFC produces inbound traffic for all car types placed at each industry. // BIGFC also produces one shipment entry for each preplaced boxcar, reefer and gondola // Update this industries grid data from the newly built grid let indID = $ops(find,industries.industry,all) let indID = $set(@indID,sort) let indfound = $ops(find,ind.industry,all,industry) let indfound = $set(@indfound,sort) let indfound = $set(@indfound,dedupe) endif // REMOVE ANY INDUSTRY TAB ROWS THAT NO LONGER EXIST AS INDUSTRIES IN THE LOCATIONS GRID. // get the list of industries from the Locations grid. let locfound = $ops(find,loc.class,"industry",track) let locfound = $set(@locfound,dedupe) let locfound = $set(@locfound,sort) // get the list of industries as it exists in the Industries grid let indfound = $ops(find,ind.industry,all,industry) let indfound = $set(@indfound,dedupe) let indfound = $set(@indfound,sort) // identify and remove the data which does not pertain to valid industry tracks. let invalidinds = $set(@indfound,difference,@locfound) let invalidinds = $set(@invalidinds,dedupe) if (invalidinds<>"") let temp = @invalidinds while ($set(@temp,count)>0) let rowid = $string(@temp,nexttoken,",") let killrow = $ops(find,ind.industry,@rowid,id) call $ops(delete, ind, @killrow) endwhile // update message and note let message = @message + "> Removed rows with invalid data @invalidinds, these tracks are not Industries.@cr@" note @message @waitmessage endif // REMOVE ANY CARS PLACED AT INDUSTRIES WHICH ARE NOT AUTHORIZED TO HANDLE THEM // Get the list of cars placed at Industries let setcInd = $ao_dev(getset,cInds) let setcXO = $ao_dev(getset,cXO) let templist = @setcInd // exlude XO cars from this test as they don't reference the Industries grid let templist = $set(@templist,difference,@setcXO) // loop thru testing the cars for valid locations while (templist<>"") // for each car get the current location and the aar code. let xcar = $set(@templist,get,0) let templist = $set(@templist,remove,0) let xloc = $car(@xcar,tracklabel) let xaar = $car(@xcar,aar) // check for aar override code let override = $car(@xcar,aaroverride) if (override <> "") let xaar = @override endif // get the list of aar codes with valid entries for this location let xvalid = $ops(find,industries.industry,@xloc,aar) if ($set(@xvalid,contains,@xaar)=0) // Before deleting car check ind grid for an acceptable single character code for this car let X = $substr(0,1,@xaar) if ($set(@xvalid,contains,@x)=0) // delete the car from the layout. // update message and note let message = @message + "> @xcar removed from @xloc@. No car orders for @xaar in Industries grid.@cr@" note @message @waitmessage train @xcar;train car @xcar;train car delete car endif endif endwhile // FILL VIAIN AND VIAOUT COLUMNS USING UPDATED VIACLASSYARD DATA FROM LOCATIONS TAB // ONLY DO THIS CHECK IF THE VIAIN COLUMN HAS TILDES ONLY NO EXISTING LABELS let checkall = $ops(find,industries.viain,all) let checktilde = $ops(find,industries.viain,"~") let test = $set(@checkall,difference,@checktilde) if (test = "") call $ops(reset) // get the full list of row numbers in the Industries grid let indrows = $ops(find,industries.industry,all,id) let temp = @indrows while (temp<>"") // get each industry row id in turn let row = $string(@temp,nexttoken,",") // find the industry label for the row number let ind = $ops(get,industries.industry,@row) // find the viaclassyard entry for the industry label let via = $ops(find,locations.track,@ind,viaclassyard) // if via is null make it a tilde if (via="") ; let via = "~" ; endif // if staging is interchange make viain and viaout into a tilde let staging = $ops(get,industries.staging,@row,staging) let staging = $set(@staging,intersection,@tints) if (staging <> "") let via = "~" endif // write the new via entry into the industries grid call $ops(set,industries.viain,@row,@via) call $ops(set,industries.viaout,@row,@via) endwhile // update message and note let message = @message + "> ViaIn and ViaOut data confimed as valid Class Yards.@cr@" note @message @waitmessage endif // CHECK IF ALL CLASS YARDS ARE REFERENCED IN THE INDUSTRIES GRID // get all class yards data from locations grid and industries grid let omitted = "" let locyards = $ops(find,locations.class,class yard,track) let indyards = $ops(find,industries,viain,all,viain) let indyards2 = $ops(find,industries.viaout,all,viaout) let indyards = $set(@indyards,union,@indyards2) // dedupe and remove the tildes let indyards = $set(@indyards,dedupe) let indyards = $set(@indyards,difference,"~") // compare both, issue warning if any class yard is omitted from industries grid let omitted = $set(@locyards,difference,@indyards) if (omitted <> "") let message = @message + "> Warning: Class Yard @omitted is missing from ViaIn or ViaOut columns. (may need edit)@cr@" note @message @waitmessage endif // ----------------------------------------------------------------------- // INSERT EXTRA LOCATION GRID EDIT FEATURE IF A CLASS YARD IS NOT USED AS A VIA if (omitted <> "") // update notebox notebox Edit the Industries grid if necessary before continuing the FixOps process. // open industries grid for editing call $ops(show,industries) // display industries grid to enable user editing before processing sequence grid // Update message and note. let message = @message + @cr + "YOU CAN EDIT THE INDUSTRIES GRID IF NECESSARY (OPTIONAL)@cr@" let message = @message + "> Adjust Shipper or Receiver entries in S/R column.@cr@" // if layout has class yards suggest edit ViaIn/ViaOut columns if (tyards<>"") let message = @message + "> Adjust ViaIn and ViaOut Class Yard routing if necessary.@cr@" endif note @message // GET USER INPUT call $msgbox("Optionally Edit the Industries grid and apply the changes. Then click OK here to continue the FixOps process.") call $ops(hide,ops) // refresh data and continue with industries grid checks view refresh call $ops(reset) // display a "please wait" notebox notebox Updating Industries Grid - Please Wait endif // ----------------------------------------------------------------------- // IDENTIFY CARS WRONGLY PLACED AT CLASS YARDS WHICH ARE NOT AUTHORIZED TO HANDLE THEM // Get the list of cars placed at Yards let cyards = $ao_dev(getset,cyard) let templist = @cyards // exlude XO cars from this test as they do not reference the Industries grid let templist = $set(@templist,difference,@setcXO) while (templist<>"") // for each car get the current location and the aar code. let xcar = $set(@templist,get,0) let templist = $set(@templist,remove,0) let xloc = $car(@xcar,tracklabel) let xaar = $car(@xcar,aar) // check for aar override code let override = $car(@xcar,aaroverride) if (override <> "") let xaar = @override endif // get the list of aar codes with valid entries for this location let xvalid = $ops(find,industries.viaout,*@xloc*,aar) if ($set(@xvalid,contains,@xaar)=0) // if the aar code is not listed in the viaout then set the car dest to staging and continue checking let sendto = $ao_dev(getset,tstagingplus) let sendto = $set(@sendto,get,0) let $car(@xcar,dest) = @sendto // get next car let message = @message + "> AAR @xaar type not authorized at @xloc@ yard. @xcar rerouted to @sendto@. @cr@" note @message @waitmessage endif endwhile // VALID INDUSTRIES WITH NO MATCHING DATA IN INDUSTRIES GRID REQUIRE AT LEAST ONE CAR ORDER // check layout car types for availability of XM boxcars let allaar = $ops(find,cars.aar,all,aar) let allaar = $set(@allaar,sort) let allaar = $set(@allaar,dedupe) let aar = $set("XM",intersection,@allaar) // use type XM if they exist on layout, otherwise use type X for any box car if (aar = "") ; let aar = "X" ; endif // get the list of industries from the Locations grid. let locfound = $ops(find,loc.class,"industry",track) let locfound = $set(@locfound,dedupe) let locfound = $set(@locfound,sort) // get the list of industries as it exists in the Industries grid let indfound = $ops(find,ind.industry,all,industry) let indfound = $set(@indfound,dedupe) let indfound = $set(@indfound,sort) // identify industries with no data in the industries tab. let missinginds = $set(@locfound,difference,@indfound) // Ignore any track labels which are classed as XO Reserved let setTxo = $ops(find,locations.class,"xo reserved",track) let missinginds = $set(@missinginds,difference,@setTxo) // add any required new industry rows with a car order for an inbound box car if (missinginds<>"") let templist = @missinginds let added = "" while (templist<>"") let X = $set(@templist,get,0) let templist = $set(@templist,remove,0) // Only process this if the track reference is not an invalid numeric only label (reported on Locations tab) let y = @X - @X if (y<>0) // then X can't be numeric, label is valid, so add some Car Order data for this Industry. // Duplicate the first row in the grid to retain its info in a new row number call $ops (duplicate, ind, 1) // modify the first row to provide inbound boxcar traffic for Ind @X call $ops(set,ind.industry,1,@x) call $ops(set,ind.aar,1,@aar) call $ops(set,ind.S/R,1,"R") call $ops(set,ind.load,1,"supplies") let added = $set(@added,add,@X) endif endwhile // update message and note let message = @message + "> Car Orders added for unpopulated industries @added@.@cr@" note @message @waitmessage endif // VALIDATE THE INDUSTRIES AAR COLUMN (AAR must also exist as a car on the layout). // or if a Single Letter AAR code is used in grid a matching full code should exist on layout let aarlist = $ops(find,cars.aar,all,aar) let aarlist = $set(@aarlist,dedupe) let aarlist = $set(@aarlist,sort) let aargrid = $ops(find,ind.industry,all,aar) let aargrid = $set(@aargrid,dedupe) let invalid = $set(@aargrid,difference,@aarlist) let invalid = $set(@invalid,sort) let templist = @invalid while (templist<>"") let aar = $set(@templist,get,0) let templist = $set(@templist,remove,0) let rows = $ops(find,inds.aar,@aar,id) // Check single character aar codes in grid for matching two character codes on layout let length = $string(@aar,length) if (length = 1) let test = "," + @aar if ($string(@aarlist,contains,@test)=1) // there is a match so we can just skip to the next aar code. continue endif endif // Check the aar code from the grid to ensure it exists, if not remove it. if ($set(@aarlist,contains,@aar)=0) while ($set(@rows,count)>0) let R = $set(@rows,get,0) let rows = $set(@rows,remove,0) // update message and note let message = @message + "> Error on row @R@. No type @aar cars exist on this layout. Needs fixing.@cr" note @message @waitmessage endwhile endif endwhile // VALIDATE S/R COLUMN (must be either S or R, reset any errors to R) // it should be impossible to put anything but S or R into this column, but it can be done by script. let check = $ops(find,ind.industry,all,S/R) let check = $set(@check,dedupe) let check = $set(@check,difference,"S,R") let errors = $ops(find,ind.S/R,@check,id) if (errors <> "") while ($set(@errors,count)>0) let R = $set(@errors,get,0) let check = $set(@errors,remove,0) call $ops(set,ind.S/R,@R,"R") endwhile endif // FIX LOAD COLUMN ERRORS - ANY LOADNAME ACCEPTABLE BUT CAN'T BE NULL. let invalid = $ops(find,ind.load,"",id) if (invalid<>"") let temp = @invalid while (temp<>"") let rowID = $string(@temp,nexttoken,",") call $ops(set,ind.load,@rowID,"freight") // update message and note let message = @message + "> Loadname 'freight' added to row @rowID@. Edit if necessary.@cr@" note @message @waitmessage endwhile endif // CHECK AND FIX INDUSTRIES STAGING COLUMN // Label must be Staging, Interchange or Tilde. // this should also catch any null entries in this column. let tstagingplus = $ao_dev(getset,tStagingplus) let data = $ops(find,ind.staging,all,id) let data2 = $ops(find,ind.staging,all,staging) let data2 = $set(@data,dedupe) let data2 = $set(@data2,difference,"~") let data2 = $set(@data2,difference,@tstagingplus) if (data2 <> "") let templist = @data while (templist<>"") let rowID = $string(@templist,nexttoken,",") let label = $ops(get,ind.staging,@rowID,staging) // replace null labels with Tilde. if (label = "") call $ops(set,ind.staging,@rowID,"~") let message = @message + "> Row @rowID staging column null entry reset to '~' (Tilde).@cr@" note @message @waitmessage continue endif // ignore existing Tildes. if (label ="~") continue endif // replace invalid staging labels with Tilde. if ($set(@tstagingplus,contains,@label)=0) call $ops(set,ind.staging,@rowID,"~") // update message and note let message = @message + "> Row @rowID staging column invalid @label entry reset to '~' (Tilde).@cr@" note @message @waitmessage continue endif endwhile endif // CHECK AND FIX VIAIN COLUMN, All labels must be Class Yards, either single label, csv list or tilde. let tyards = $ops(find,loc.class,"class yard",track) let vyards = $set(@tyards,add,"~") let data = $ops(find,ind.viain,all,id) let vdata = $set(@data,dedupe) if (vdata <> "") let templist = @data while (templist<>"") let rowID = $string(@templist,nexttoken,",") let label = $ops(get,ind.viain,@rowID,staging) // replace null labels with Tilde. if (label = "") call $ops(set,ind.ViaIn,@rowID,"~") let message = @message + "> Row @rowID ViaIn column null entry reset to '~' (Tilde).@cr@" note @message @waitmessage continue endif // ignore existing Tildes. if (label = "~") continue endif // ignore genuine class yard labels if ($set(@vyards,contains,@label)=1) continue endif // ignore CSV lists containing only valid labels if ($set(@label,intersection,@vyards) = $set(@label,union,@label) continue endif // ignore multiple labels used for complex routing if ($set(@label,count)>1) continue endif // anything left must be an invalid single label,so take it out and substitute a Tilde. call $ops(set,ind.ViaIn,@rowID,"~") // update message and note let message = @message + "> Row @rowID ViaIn column invalid entry @label reset to '~' (Tilde).@cr@" note @message @waitmessage continue endwhile endif // CHECK AND FIX VIAOUT COLUMN, All labels must be Class Yards, either single label, csv list or tilde. let tyards = $ops(find,loc.class,"class yard",track) let vyards = $set(@tyards,add,"~") let data = $ops(find,ind.viaout,all,id) let vdata = $set(@data,dedupe) if (vdata <> "") let templist = @data while (templist<>"") let rowID = $string(@templist,nexttoken,",") let label = $ops(get,ind.viaout,@rowID,staging) // replace null labels with Tilde. if (label = "") call $ops(set,ind.viaout,@rowID,"~") let message = @message + "> Row @rowID ViaOut column null entry reset to '~' (Tilde).@cr@" note @message @waitmessage continue endif // ignore existing Tildes. if (label = "~") continue endif // ignore genuine class yard labels if ($set(@vyards,contains,@label)=1) continue endif // ignore CSV lists containing only valid labels if ($set(@label,intersection,@vyards) = $set(@label,union,@label) continue endif // ignore multiple labels used for complex routing if ($set(@label,count)>1) continue endif // anything left must be invalid so take it out and substitute a Tilde. call $ops(set,ind.viaout,@rowID,"~") // update message and note let message = @message + "> Row @rowID ViaOut column invalid entry @label reset to '~' (Tilde).@cr@" note @message @waitmessage continue endwhile endif // FIX GRID IF LAYOUT HAS AN INTERCHANGE THAT IS NOT INCLUDED IN THE INDUSTRIES GRID STAGING COLUMN // get the list of interchanges let tints = $ao_dev(getset,tints) // get the contents of the industries staging column, dedupe, sort and remove tildes. let gridints = $ops(find,industries.staging,all,staging) let gridints = $set(@gridints,dedupe) let gridints = $set(@gridints,sort) let gridints = $set(@gridints,difference,"~") let gridints = $set(@gridints,intersection,@tints) let gridtildes = $ops(find,industries.staging,"~",id) // if there are no gridtildes use a staging label row instead if (gridtildes="") let S = $ao_dev(getset,tstaging) let S = $set(@S,get,0) let gridtildes = $ops(find,industries.staging,@S,id) endif // Add any interchange labels missing from the Industries staging column. if (tints<>"") if ($set(@gridints,count)=0) // check the industries grid for missing interchanges let templist = @tints while (templist<>"") let X = $set(@templist,get,0) let templist = $set(@templist,remove,0) //inner loop to cycle through all identified gridtildes let gridtildes = $ops(find,industries.staging,"~",id) while (gridtildes <> "") let R = $string(@gridtildes,nexttoken,",") // duplicate the selected row to preserve its original data in a new row call $ops (duplicate, ind, @R) // edit the original row to provide traffic from Interchange @X call $ops(set,ind.staging,@R,@X) // remove the viain and viaout entries from the interchange train // so local train can handle the interchange // only do this if there are also staging yards on the layout let staginglabels = $ops(find,loc.class,staging,track) if (staginglabels <> "") call $ops(set,ind.viain,@R,"~") call $ops(set,ind.viaout,@R,"~") endif endwhile // reset gridtildes before repeating inner loop let gridtildes = $ops(find,industries.staging,"~"all,id) endwhile // update message and note let message = @message + "> Car Orders added for traffic from @tints@ Interchange.@cr@" note @message @waitmessage endif endif // IF THERE ARE NO STAGING YARDS (ONLY INTERCHANGES) THEN REMOVE TILDE ENTRIES FROM GRID let staginglabels = $ops(find,loc.class,staging,track) let gridtildes = $ops(find,industries.staging,"~",id) if (staginglabels = "") while (gridtildes <> "") let xrow = $string(@gridtildes,nexttoken,",") call $ops(delete,industries,@xrow) endwhile // update message and note let message = @message + "> Removed Tilde rows from Industries Grid as there is no Staging.@cr@" note @message @waitmessage endif // --------------------------------------------------------------------------------- // PROCEDURE TO ADJUST LOADNAMES FOR TANKS, GONDOLAS AND HOPPERS. // USES KEYWORDS FROM LOCATION NAME TO IDENTIFY A LIKELY LOADNAME proc checkload while (testrows <> "") let xrow = $string(@testrows,nexttoken,",") let xload = $ops(get,industries.load,@xrow) let location = $ops(get,industries.location,@xrow) // change spaces to commas let X = "" let Y = "" while (location<>"") let X = $string(@location,nexttoken," ") let Y = $set(@Y,union,@X) endwhile let location = @Y let test = $set(@location,intersection,@indnames) if (test = "") continue else let xload = @newload call $ops(set,industries.load,@xrow,@xload) endif endwhile endproc // --------------------------------------------------------------------------------- // ADJUST LOADNAMES FOR TANKS, GONDOLAS AND HOPPERS BASED ON LOCATION NAME KEYWORDS // get set of industry row numbers for tank cars, check for dairy let trows = $ops(find,industries.aar,t*) let testrows = @trows let indnames = "milk,dairy,dairies,creamery" let newload = "milk" call checkload // get set of industry row numbers for tank cars, check for fuel oil let trows = $ops(find,industries.aar,t*) let testrows = @trows let indnames = "oil,fuel,loco,engine,power" let newload = "fuel oil" call checkload // get set of industry row numbers for tank cars, check for chemicals let trows = $ops(find,industries.aar,t*) let testrows = @trows let indnames = "chemical,chemicals" let newload = "chemicals" call checkload // get set of industry row numbers for tank cars, check for paint let trows = $ops(find,industries.aar,t*) let testrows = @trows let indnames = "paint,paints" let newload = "paint" call checkload // get set of industry row numbers for gondolas and hoppers, check for coal let grows = $ops(find,industries.aar,g*) let hrows = $ops(find,industries.aar,h*) let grows = $set(@grows,union,@hrows) let testrows = @grows let indnames = "coal,loco,locomotive,engine,engines,power" let newload = "coal" call checkload // get set of industry row numbers for gondolas and hoppers, check for aggregates let grows = $ops(find,industries.aar,g*) let hrows = $ops(find,industries.aar,h*) let grows = $set(@grows,union,@hrows) let testrows = @grows let indnames = "aggregates,mine,quarry,pit" let newload = "aggregates" call checkload // get set of industry row numbers for covered hoppers, check for cement let lrows = $ops(find,industries.aar,l*) let testrows = @lrows let indnames = "cement" let newload = "cement" call checkload // get set of industry row numbers for covered hoppers, check for grain let lrows = $ops(find,industries.aar,l*) let testrows = @lrows let indnames = "grain,silo,silos,co-op" let newload = "grain" call checkload // get set of industry row numbers for covered hoppers, check for powders let lrows = $ops(find,industries.aar,l*) let testrows = @lrows let indnames = "chemical,chemicals,paint,paints" let newload = "powder" call checkload // get set of industry row numbers for flat cars, check for logs let frows = $ops(find,industries.aar,f*) let testrows = @frows let testrows = @lrows let indnames = "logs,logging,forestry" let newload = "logs" call checkload // get set of industry row numbers for flat cars, check for lumber let frows = $ops(find,industries.aar,f*) let testrows = @frows let indnames = "mill,sawmill,sawmills,lumber,timber" let newload = "lumber" call checkload // update message and note let message = @message + "> Default loadnames checked against Industries for AAR types F, G, H, L, and T.@cr@" note @message @waitmessage // UPDATE SAVEDMESSAGE BEFORE SUGGESTING EDIT let savedmessage = @savedmessage + @message + @cr // UPDATE NOTEBOX notebox Edit the Industries grid if necessary before continuing the FixOps process. // OPEN INDUSTRIES GRID FOR EDITING call $ops(show,industries) // DISPLAY INDUSTRIES GRID AND ENABLE USER EDITING BEFORE PROCESSING THE SEQUENCE GRID // Update message and note. let message = @message + @cr + "YOU CAN EDIT THE INDUSTRIES GRID IF NECESSARY (OPTIONAL)@cr@" let message = @message + "> Adjust Shipper or Receiver entries in S/R column.@cr@" let message = @message + "> Adjust autogenerated load names to match Industry functions.@cr@" let message = @message + "> Add or duplicate rows for extra loadnames, or delete unwanted rows.@cr@" // if layout has class yards suggest edit ViaIn/ViaOut columns if (tyards<>"") let message = @message + "> Adjust ViaIn and ViaOut Class Yard routing if still necessary.@cr@" endif note @message // GET USER INPUT call $msgbox("Optionally Edit the Industries grid and apply the changes. Then click OK here to continue the FixOps process.") call $ops(hide,ops) // ============================================================================== // DEFINE A PROCEDURE TO IDENTIFY THE MOST APPROPRIATE ENGINE // requires one parameter - the label of the startat location. proc getengine // get default engine from let engine = $ops() let x = %1 // customize the engine data if startat is occupied by an engine let engine = "" let occby = $track(@x,occupiedby) let enginesplus = $ops(find,XOcars.car,E*,car) let tenders = $ops(find,XOcars.car,ET*,car) let engine = $set(@enginesplus,difference,@tenders) let engine = $set(@engine,intersection,@occby) // if the startat track contains an engine then use it if (engine<>"") // engine was located on startat track let engine = $set(@engine,get,0) return else // if no engine was found locate and use the nearest engine // get a tracker car from the first staging track let tracker = $track(@x,occupiedby) // get a list of all engines let enginesonly = "" let occby = $track(@x,occupiedby) let enginesplus = $ops(find,XOcars.car,E*,car) let tenders = $ops(find,XOcars.car,ET*,car) let selfprop = $ops(find,XOcars.car,EP*,car) let enginesonly = $set(@enginesplus,difference,@tenders) let enginesonly = $set(@enginesonly,difference,@selfprop) if (tracker<>"") let tracker = $string(@tracker,nexttoken,",") // find the nearest engine to the tracker car let tempengines = @enginesonly let engine = $set(@tempengines,get,0) let shortestdist = $car(@tracker,distto,@engine) while (tempengines<>"") let testengine = $string(@tempengines,nexttoken,",") let dist = $car(@tracker,distto,@testengine) if (dist < @shortestdist) let shortestdist = @dist let engine = @testengine endif endwhile endif // pass the engine location back for adding to the visits list. let enginelocation = $car(@engine,tracklabel) endif endproc // ============================================================================== // DEFINE A PROCEDURE TO GENERATE A NEW SEQUENCE GRID WITH MULTIPLE TRAINS proc makesequence // COLLECT KEY TRACK SETS (These are track labels) call $ao_dev(init) let staginglabels = $ops(find,loc.class,staging,track) let interchangelabels = $ops(find,loc.class,interchange,track) let industrylabels = $ops(find,loc.class,industry,track) let xotracklabels = $ops(find,loc.class,xo reserved,track) let yardlabels = $ops(find,loc.class,class yard,track) let allviainlabels = $ops(find,industries.viain,all,viain) let localengine = "" // PROVIDE A TRAIN FROM EACH STAGING YARD TO ALL CLASS YARDS IN THE VIAIN COLUMN let tilderows = $ops(find,industries.staging,"~") let tildeviain = $ops(find,industries.viain,"~") let tildeviaout = $ops(find,industries.viaout,"~") let yardinrows = $ops(find,industries.viain,all) let yardinrows = $set(@yardinrows,difference,@tildeviain) let yardoutrows = $ops(find,industries.viaout,all) let yardoutrows = $set(@yardoutrows,difference,@tildeviaout) let tempstaging = @staginglabels while (tempstaging <> "") let token = $string(@tempstaging,nexttoken,",") if (token = "EOL") ; break ; endif let tokenrows = $ops(find,industries.staging,@token) let tokenrows = $set(@tokenrows,union,@tilderows) let visits = "" // test for a fast freight let test = $set(@yardinrows,intersection,@tokenrows) // if staging serves one or more class yards, add a FF train to the sequence. if (test <> "") // ---------------------------------------------------- // generate a new sequence grid row for the fast freight call $ao_dev(dev,"add basic train seq") // find the new rowid let rowcount = $ops(find,seq.startat,all) let rowid = $set(@rowcount,count) // set the trainname, startat, endat, visits and pull value let trainname = @token + " fast freight" call $ops(set,seq.trainname,@rowid,@trainname) call $ops(set,seq.startat,@rowid,@token) call $ops(set,seq.endat,@rowid,@token) // select the engine call getengine @token call $ops(set,seq.engine,@rowid,@engine) let visitrows = $ops(find,industries.industry,all) let visitrows = $set(@visitrows,intersection,@tokenrows) // adjust visits for engine location let visits = $set(@yardlabels,union,@enginelocation) call $ops(set,seq.visits,@rowid,@visits) call $ops(set,seq.comment,@rowid,"Generated by FixOps") let pullvalue = $ops(ncarstopull) call $ops(set,seq.carstopull,@rowid,@pullvalue) // ---------------------------------------------------- let servedrows = $set(@yardinrows,intersection,@tokenrows) let servedlabels = $ops(get,industries.viain,@servedrows) let servedlabels = $set(@servedlabels,dedupe) let tempservedlabels = @servedlabels let classvisits = "" let extravisits = "" while (tempservedlabels <> "") let localstart = $string(@tempservedlabels,nexttoken,",") let localstartrows = $ops(find,industries.viain,@localstart) let found = @localstart // ---------------------------------------------------- // generate a new sequence grid row from each viain class yard call $ao_dev(dev,"add basic train seq") // find the new innerrowid let rowcount = $ops(find,seq.startat,all) let innerrowid = $set(@rowcount,count) // identify any differences between viain and viaout for visits list let viaoutrows = $ops(find,industries.viain,@localstart) let extravisits = $ops(get,industries.viaout,@viaoutrows) let extravisits = $set(@extravisits,dedupe) // set the trainname, startat, endat, visits and pull value let trainname = @localstart + " local" call $ops(set,seq.trainname,@innerrowid,@trainname) call $ops(set,seq.startat,@innerrowid,@localstart) call $ops(set,seq.endat,@innerrowid,@localstart) let visitrows = $ops(find,industries.industry,all) let visitrows = $set(@visitrows,intersection,@localstartrows) // select the engine call getengine @localstart call $ops(set,seq.engine,@innerrowid,@engine) // set this engine as the preferred local engine let localengine = @engine let localenglocation = $car(@engine,tracklabel) // adjust visits for engine location let visits = $set(@visits,union,@enginelocation) let visits = $ops(get,industries.industry,@visitrows) // if viaout yard different to viainyard add it to the visits list if (extravisits<>"") let visits = $set(@visits,union,@extravisits) endif let visits = $set(@visits,dedupe) call $ops(set,seq.visits,@innerrowid,@visits) call $ops(set,seq.comment,@innerrowid,"Generated by FixOps") let pullvalue = $ops(ncarstopull) call $ops(set,seq.carstopull,@innerrowid,@pullvalue) // save industry labels serviced from class yards let classvisits = $set(@classvisits,union,@visits) let classvisits = $set(@classvisits,dedupe) // ---------------------------------------------------- endwhile endif // PROVIDE A TRAIN FROM EACH STAGING YARD TO ALL INDUSTRIES IF TILDE IS IN VIAIN // test for a local train from current staging (token) let industryrows = $ops(find,industries.viain,"~") let tokenrows = $ops(find,industries.staging,@token) let tokenrows = $set(@tokenrows,union,@tilderows) let industryrows = $set(@industryrows,intersection,@tokenrows) if (industryrows <> "") // ---------------------------------------------------- // generate a new sequence grid row for a staging local call $ao_dev(dev,"add basic train seq") // find the new rowid let rowcount = $ops(find,seq.startat,all) let rowid = $set(@rowcount,count) // set the trainname, startat, endat, visits and pull value let trainname = @token + " peddler" call $ops(set,seq.trainname,@rowid,@trainname) call $ops(set,seq.startat,@rowid,@token) call $ops(set,seq.endat,@rowid,@token) let visitrows = $ops(find,industries.industry,all) let visitrows = $set(@visitrows,intersection,@tokenrows) let visitrows = $set(@visitrows,intersection,@tildeviain) // select the engine call getengine @token call $ops(set,seq.engine,@rowid,@engine) let visits = $ops(get,industries.industry,@visitrows) // remove industries serviced through class yards from staging local let visits = $set(@visits,difference,@yardlabels) let visits = $set(@visits,difference,@classvisits) // adjust visits for engine location let visits = $set(@visits,union,@enginelocation) let visits = $set(@visits,dedupe) call $ops(set,seq.visits,@rowid,@visits) call $ops(set,seq.comment,@rowid,"Generated by FixOps") let pullvalue = $ops(ncarstopull) call $ops(set,seq.carstopull,@rowid,@pullvalue) // ---------------------------------------------------- endif endwhile // PROVIDE A TRAIN FROM EACH INTERCHANGE TO ALL DESIGNATED INDUSTRIES let tempints = @interchangelabels while (tempints <> "") let token = $string(@tempints,nexttoken,",") if (token = "EOL") ; break ; endif let tokenrows = $ops(find,industries.staging,@token) // ---------------------------------------------------- // generate a new sequence grid row for an interchange turn call $ao_dev(dev,"add basic train seq") // find the new rowid let rowcount = $ops(find,seq.startat,all) let rowid = $set(@rowcount,count) // set the trainname, startat, endat, visits and pull value let trainname = @token + " interchange turn" call $ops(set,seq.trainname,@rowid,@trainname) call $ops(set,seq.startat,@rowid,@token) call $ops(set,seq.endat,@rowid,@token) let visitrows = $ops(find,industries.industry,all) let visitrows = $set(@visitrows,intersection,@tokenrows) // select the engine if (localengine <> "") let engine = @localengine let localenglocation = $car(@localengine,tracklabel) else call getengine @token endif call $ops(set,seq.engine,@rowid,@engine) let visits = $ops(get,industries.industry,@visitrows) let visits = $set(@visits,difference,@yardlabels) let visits = $set(@visits,difference,@xotracklabels) if (localenglocation <> "") let enginelocation = @localenglocation endif let visits = $set(@visits,dedupe) // adjust visits for engine location let visits = $set(@visits,union,@enginelocation) call $ops(set,seq.visits,@rowid,@visits) call $ops(set,seq.comment,@rowid,"Generated by FixOps") // pullvalue needs to be the number of cars occupying the interchange let pullvalue = $ops(ncarstopull) let thistrain = $track(@token,occupiedby) let pullvalue = $set(@thistrain,count) call $ops(set,seq.carstopull,@rowid,@pullvalue) // ---------------------------------------------------- endwhile // END OF MAKESEQUENCE PROCEDURE DEFINITION endproc // ============================================================================== // SEQUENCE TAB SECTION // UPDATE NOTEBOX notebox BUILDING OR ADJUSTING SEQUENCE GRID DATA // UPDATE MESSAGE AND NOTE. let message = "SEQUENCE GRID CHECKS@cr@" note @message // CHECK FOR AN EXISTING SEQUENCE GRID, CONTINUE IF FOUND, CREATE FIRST IF NOT FOUND. // OTHERWISE CONTINUE CHECKING USING EXISTING SEQUENCE GRID let testgrid = $ops(find,sequence.startat,all,startat) if (testgrid = "") call makesequence // update message and note let message = @message + "> Train Sequence grid data generated from scratch.@cr@" note @message else // if this is a revamp clear the sequence grid and start over if (revamp <> "~") // count the existing rows let oldseqrows = $ops(find,sequence.startat,all) let oldseqcount = $set(@oldseqrows,count) // clear the grid while (oldseqcount>0) call $ops(delete,sequence,@oldseqcount) let oldseqcount = @oldseqcount - 1 endwhile // rebuild the sequence grid call makesequence // update message and note let message = @message + "> Train Sequence grid data rebuilt from scratch.@cr@" note @message endif endif // IF THERE ARE PASSENGER TRAINS LEFT ON THE LAYOUT ADD THEM TO THE SEQUENCE // ONLY DO THIS IF THIS IS THE FIRST ATTEMPT TO BUILD THE SEQUENCE if (control = "") if (xopasscars <> "") let Ploc = "" let Pcar = "" let temp = @xopasscars let engine = "" while (temp <> "") let Pcar = $string(@temp,nexttoken,",") let Xtrack = $car(@Pcar,tracklabel) let Ploc = $set(@Ploc,union,@xtrack) let type = $car(@Pcar,aar) if (type = "EP") let engine = @Pcar endif endwhile // passstart is the actual locations of the passenger carriages let passstart = $set(@PassStart,union,@Ploc) // build a train for each start position let Pstart = @passstart while (Pstart <> "") let thisstart = $string(@Pstart,nexttoken,",") // remove the passstart positions from Passvisits let passvisits = $set(@passvisits,difference,@Ploc) let comment = "Generated by FixOps" let trainname = @thisstart + " passenger train" let carstopull = $set(@xopasscars,count) // build the sequence and find an engine // generate a new sequence grid row call $ao_dev(dev, "add basic train seq") // find the new rowid let rowcount = $ops(find,seq.startat,all) let rowid = $set(@rowcount,count) // insert the known data call $ops(set,seq.visits,@rowid,@passvisits) call $ops(set,seq.startat,@rowid,@thisstart) call $ops(set,seq.endat,@rowid,@thisstart) call $ops(set,seq.trainname,@rowid,@trainname) call $ops(set,seq.comment,@rowid,@comment) call $ops(set,seq.carstopull,@rowid,@carstopull) // if the train is not a self propelled EP find the engine if (engine <> "") call $ops(set,seq.engine,@rowid,@engine) else call getengine @thisstart call $ops(set,seq.engine,@rowid,@engine) endif // add the engine track to the visits list let addition = $car(@engine,tracklabel) let passvisits = $set(@passvisits,union,@addition) call $ops(set,seq.visits,@rowid,@passvisits) endwhile endif endif // IF THERE ARE XO BLOCK TRAINS LEFT ON THE LAYOUT ADD THEM TO THE SEQUENCE // ONLY DO THIS IF THIS IS THE FIRST ATTEMPT TO BUILD THE SEQUENCE if (control = "") let staging = $ao_dev(getset,tstaging) if (blockvisit <> "") // blockstart is staging if this is in visit list if (blockstart = "") let blockstart = $set(@blockvisit,difference,@Bloadat) // eliminate any industries from blockstart let blockstart = $set(@blockstart,difference,@industrylabels) endif // build a train for each start position let Bstart = @blockstart while (Bstart <> "") let thisstart = $string(@Bstart,nexttoken,",") // remove the thisstart position from blockvisit let blockvisit = $set(@blockvisit,difference,@thisstart) let comment = "Generated by FixOps" let trainname = @thisstart + " block freight" let carstopull = $ops(ncarstopull) // build the sequence and find an engine call $ao_dev(dev, "add basic train seq") // find the new rowid let rowcount = $ops(find,seq.startat,all) let rowid = $set(@rowcount,count) // insert the known data call $ops(set,seq.visits,@rowid,@blockvisit) call $ops(set,seq.startat,@rowid,@thisstart) call $ops(set,seq.endat,@rowid,@thisstart) call $ops(set,seq.trainname,@rowid,@trainname) call $ops(set,seq.comment,@rowid,@comment) call $ops(set,seq.carstopull,@rowid,@carstopull) // find the engine call getengine @thisstart call $ops(set,seq.engine,@rowid,@engine) // add the engine track to the visits list let addition = $car(@engine,tracklabel) let blockvisit = $set(@blockvisit,union,@addition) call $ops(set,seq.visits,@rowid,@blockvisit) endwhile endif endif // SET THE ACTIVE TRAIN MARKER TO ROW 1 call $ops(set,seq.active,1,"X") // PREPARE TO CHECK AND ADJUST THE SEQUENCE GRID // repository for list of all track labels used in the Sequence grid let allseqlabels = "" let seqrows = $ops(find,seq.engine,all) let Nseqrows = $set(@seqrows,count) let temp = @seqrows // PROCESS THE SEQUENCE GRID FOR EDITS MADE TO LOCATIONS OR INDUSTRIES GRID While (temp<>"") let R = $set(@temp,get,0) let temp = $set(@temp,remove,0) // IF THE ENGINE IS VALID THEN COLLECT THE PROPS DATA let Xcar = $ops(get,sequence.engine,@R,engine) // Identify the current track for the engine let tracklabel = $car(@Xcar,tracklabel) // Ensure the allocated engine's current position is included in the visits list // only do this if the train is not a passenger train if (xpasstrainrow <> @R) let visitlabels = $ops(get,seq.visits,@R) let visitlabels = $set(@visitlabels,add,@tracklabel) let visitlabels = $set(@visitlabels,dedupe) let visitlabels = $set(@visitlabels,sort) call $ops(set,seq.visits,@R,@visitlabels) endif // set the current tracklabel for the active engine in the car dest field. let $car(@Xcar,dest) = @tracklabel // IF THE ENGINE HAS NO ROUTE APPLY THE CURRENT TRACK LABEL TO BOTH ROUTE AND NOTE FIELDS if ($car(@xcar,route)="") let $car(@Xcar,note) = @tracklabel endif // IF THE TRAIN NAME IS NULL APPLY A DEFAULT TRAIN NAME let test = $ops(get,sequence.trainname,@R) if ( test = "") let trainname = "Train #" + @R call $ops(set,seq.trainname,@R,@trainname) // update message and note let message = @message + "> Row @R @Xcar Default Train Name requires editing (optional).@cr@" note @message endif // REFRESH THE VIEW TO UPDATE ENGINE PROPERTIES view refresh // FIX TYPO IF PERIOD USED INSTEAD OF COMMA IN VISITS LIST (A COMMON TYPO) let visitlabels = $ops(find,seq.row,@R,visits) if($string(@visitlabels,contains,".")=1) while ($string(@visitlabels,contains,".")=1) let Sleft = $string(@visitlabels,nexttoken,".") let Sright = @visitlabels let visitlabels = $set(@Sleft,union,@Sright) endwhile // update message and note let message = @message + "> Row @R Visits - Fixed syntax error period(s) changed to comma(s).@cr@" note @message endif // FIX THE VISITS LIST TO REMOVE ANY OBSOLETE TRACKLABELS let layoutlabels = $layout(idset,tracklabels) let layoutlabels = $set(@layoutlabels,dedupe) let layoutlabels = $set(@layoutlabels,sort) let layoutlabels = $set(@layoutlabels,difference,"~") let visitlabels = $ops(get,seq.visits,@R) let visitlabels = $set(@visitlabels,intersection,@layoutlabels) let visitlabels = $set(@visitlabels,dedupe) let visitlabels = $set(@visitlabels,sort) // REMOVE STARTAT AND ENDAT CODES FROM THE VISITS LIST let xstart = $ops(get,seq.startat,@R) let xend = $ops(get,seq.endat,@R) let visitlabels = $set(@visitlabels,difference,@xstart) let visitlabels = $set (@visitlabels,difference,@xend) call $ops(set,seq.visits,@R,@visitlabels) // COLLECT DATA FOR ALL TRACK LABELS USED IN THE SEQUENCE GRID let allseqlabels = $set(@allseqlabels,union,@visitlabels) let allseqlabels = $set(@allseqlabels,union,@Xstart) ; // was Rstart let allseqlabels = $set(@allseqlabels,union,@Xend) ; // was Rend // REMOVE ANY INVALID TRAINS -- TRAINS MUST NOT STARTAT OR ENDAT INDUSTRIES. let tInds = @industrylabels if ($set(@tInds,contains,@Xstart)=1) call $ops(delete,sequence,@R) // update message and note let message = @message + "> Removed row @R Trains cannot start from Industries.@cr@" note @message continue endif if ($set(@tInds,contains,@Xend)=1) call $ops(delete,sequence,@R) // update message and note let message = @message + "> Removed row @R Trains cannot terminate at Industries.@cr@" note @message continue endif // FIX PULL VALUE TO EXACT CARCOUNT IF STARTAT OR ENDAT IS AN INTERCHANGE // all cars left at interchange need moving also car floats must not be overloaded let tints = $ao_dev(getset,tints) let xtest = $set(@Xstart,union,Xend) let xtest = $set(@xtest,intersection,@tints) if (xtest <> "") let xtest = $string(@xtest,nexttoken,",") let xcars = $track(@xtest,occupiedby) let xcount = $set(@xcars,count) if ($set(@xstart,intersection,@tints)<>"") call $ops(set,sequence.carstopull,@R,@xcount) // update message and note let message = @message + "> Row @R CarsToPull set to @xcount for @xtest@.@cr@" note @message endif else // if carstopull cell is currently null apply the default carstopull value let test = $ops(get,sequence.carstopull,@R) if (test = "") let pullvalue = $ops(ncarstopull) call $ops(set,sequence.carstopull,@R,@pullvalue) // update message and note let message = @message + "> Pull value set to default @pullvalue for row @R@.@cr@" note @message endif endif endwhile ; // END OF LOOP TO PROCESS SEQUENCE GRID ROWS // TIDY UP REPOSITORY OF TRACK LABELS USED IN THE SEQUENCE GRID let allstarts = $ops(find,seq.startat,all,startat) let allends = $ops(find,seq.endat,all,endat) let allseqlabels = $set(@allseqlabels,union,@allstarts) let allseqlabels = $set(@allseqlabels,union,@allends) let allseqlabels = $set(@allseqlabels,dedupe) let allseqlabels = $set(@allseqlabels,sort) // IDENTIFY INDUSTRIES WHICH ARE NOT SERVED BY ANY TRAINS let Tinds = $ao_dev(getset,Tinds) let test = $set(@Tinds,difference,@allseqlabels) if (test<>"") // update message and note let message = @message + "> Warning! - No trains are scheduled to visit Industries @test@.@cr@" let message = @message + "> Please add @test@ to one of the trains on the visits list.@cr@" note @message endif // IDENTIFY CLASS YARDS THAT ARE NOT SERVED BY ANY TRAINS let Tyards = $ao_dev(getset,Tyards) let test = $set(@Tyards,difference,@allseqlabels) if (test<>"") // update message and note let message = @message + "> Warning! - No trains visit Class Yards @test@.@cr@" note @message endif // IDENTIFY STAGING YARDS THAT ARE NOT SERVED BY ANY TRANS let Tstaging = $ao_dev(getset,Tstaging) let test = $set(@Tstaging,difference,@allseqlabels) if (test<>"") // update message and note let message = @message + "> Warning! - No trains start or end at @test@ Staging.@cr@" note @message endif // IDENTIFY INTERCHANGES THAT ARE NOT SERVED BY ANY TRAINS let Tints = $ao_dev(getset,Tints) let test = $set(@Tints,difference,@allseqlabels) if (test<>"") // update message and note let message = @message + "> Warning! - No trains start or end at @test@ Interchange.@cr@" note @message endif // IDENTIFY XO RESERVED TRACKS THAT ARE NOT SERVED BY ANY TRAINS let Txo = $ao_dev(getset,Txo) let test = $set(@Txo,difference,@allseqlabels) if (test<>"") // update message and note let message = @message + "> Warning! - No trains visit XO reserved tracks @test@. (This may be OK)@cr@" note @message endif // ALL STARTATS MUST HAVE A MATCHING ENDAT EVEN IF IT'S ON A DIFFERENT TRAIN let allstarts = $ops(find,seq.startat,all,startat) let allends = $ops(find,seq.endat,all,endat) // find orphanstarts and orphanends let orphanstarts = $set(@allstarts,difference,@allends) let orphanends = $set(@allends,difference,@allstarts) // Report errors while(@orphanstarts<>"") let OS = $string(@orphanstarts,nexttoken,",") let OE = $string(@orphanends,nexttoken,",") // update message and note let message = @message + "> Warning! No train provided from @OE to @OS@.@cr@" note @message endwhile // STARTAT POSITIONS MUST HAVE AT LEAST ONE MATCHING ENTRY IN THE INDUSTRIES GRID STAGING COLUMN. let invalid = "" let startall = $ops(find,seq.startat,all,startat) let xvalid = $ops(find,industries.staging,all,staging) let xvalid = $set(@xvalid,sort) let xvalid = $set(@xvalid,dedupe) let invalid = $set(@xvalid,difference,@startall) let invalid = $set(@invalid,dedupe) let invalid = $set(@invalid,difference,"~") let invalid = $set(@invalid,difference,@startall) if (invalid <> "") // update message and note let message = @message + "> Warning! No trains start at @invalid Staging as required by Industries grid.@cr@" note @message endif // ENDAT POSITIONS MUST HAVE AT LEAST ONE MATCHING ENTRY IN THE INDUSTRIES GRID STAGING COLUMN. let invalid = "" let endall = $ops(find,seq.endat,all,endat) let xvalid = $ops(find,industries.staging,all,staging) let xvalid = $set(@xvalid,sort) let xvalid = $set(@xvalid,dedupe) let invalid = $set(@xvalid,difference,@endall) let invalid = $set(@invalid,dedupe) let invalid = $set(@invalid,difference,"~") let invalid = $set(@invalid,difference,@endall) if (invalid <> "") // update message and note let message = @message + "> Warning! No trains terminate at @invalid Staging as required by Industries grid.@cr@" note @message endif // SAVE THE FIRST SEQUENCE GRID STARTAT ENTRY FOR COMPARISON AFTER EDIT let savedstart = $ops(get,seq.startat,1) // UPDATE SAVED MESSAGE TO INCLUDE LATEST SEQUENCE MESSAGES let savedmessage = @savedmessage + @message + @cr // UPDATE NOTEBOX notebox Edit the Sequence grid if necessary before continuing the FixOps process. // DISPLAY SEQUENCE GRID call $ops(show,sequence) // DISPLAY SEQUENCE GRID AND ENABLE USER EDITING BEFORE PROCESSING THE SEQUENCE GRID DATA // Update message and note. let message = @message + @cr + "YOU CAN EDIT THE SEQUENCE GRID IF YOU WISH (OPTIONAL)@cr@" let message = @message + "> Add any notified unvisited tracks to the Visits list.@cr@" let message = @message + "> Fix any StartAt and EndAt locations highlighted in Warnings.@cr@" let message = @message + "> Optionally change the Train Name to a name of your choice.@cr@" note @message // GET USER INPUT call $msgbox("Optionally Edit the Sequence grid and apply the changes. Then click OK here to continue the FixOps process.") call $ops(hide,ops) // ============================================================================== // NEW CHECK ON ENGINES TO ADJUST FOR EDITS TO SEQUENCE GRID STARTAT DATA // if first startat entry has been changed check again for nearest engine // this won't catch everything but is better than nothing let test = $ops(get,seq.startat,1) if (test <> @savedstart) // redisplay sequence grid to avoid having to refresh it later call $ops(show,sequence) // startat on first line of grid has been changed so get a new engine call getengine @test call $ops(set,seq.engine,1,@engine) // add location of new engine to visits list let newvisit = $car(@engine,tracklabel) let visits = $ops(get,seq.visits,1) let visits = $set(@visits,union,@newvisit) let visits = $set(@visits,dedupe) call $ops(set,seq.visits,1,@visits) view refresh call $ops(hide,sequence) endif // ============================================================================== // UPDATE THE INTRODUCTION TAB NOW THAT THE GRIDS CONTAIN OPS DATA let $ops(Intro) = "This Ops Scenario was autogenerated by the FixOps subroutine. @cr@If you have TrackLayer Builder you can edit this introduction in the Ops Central Advanced Tab." // ============================================================================== // XO CARS TAB SECTION // UPDATE NOTEBOX notebox Validating or adjusting XO car data. // UPDATE MESSAGE AND NOTE. let message = "XO CARS GRID CHECKS@cr@" note @message // GET THE KEY XO TRACK DATA let xotracklabels = $ops(find,loc.class,xo reserved,track) // ANY CAR FOUND ON AN XO RESERVED TRACK NEEDS AN XO FLAG let temp = @xotracklabels while (temp <> "") let xtrack = $string(@temp,nexttoken,",") let xocc = $track(@xtrack,occupiedby) while (@xocc <> "") let xcar = $string(@xocc,nexttoken,",") let $car(@xcar,excludeops) = "X" endwhile endwhile // PROCESS ENGINES FROM RECENTLY EDITED SEQUENCE GRID (INCLUDES CABOOSES IF AT STARTAT LOCATION) let xoseqrows = $ops(find,seq.engine,all) let temp = @xoseqrows while (temp <> "") let xrow = $string(@temp,nexttoken,",") let Rstart = $ops(get,seq.startat,@xrow) let Rend = $ops(get,seq.endat,@xrow,endat) // if the train is a turn don't bother if (Rstart = @Rend) ; continue ; endif let xcar = $ops(get,seq.engine,@xrow) let xroute = $car(@xcar,route) let xloc = $car(@xcar,tracklabel) // engine needs a route let routelength = $set(@xroute,count) if (routelength < 2) let $car(@Xcar,route) = $set(@rend,add,@xloc) let $car(@Xcar,note) = $set(@xloc,add,@rend) endif // If there is a caboose on the startat track route it to the endat track let xtest = $track(@Rstart,occupiedby) let xtest = $set(@xtest,intersection,@cenginesplus) let xtest = $set(@xtest,difference,@enginesonly) let xcar = $set(@xtest,get,0) let xroute = $car(@xcar,route) let xloc = $car(@xcar,tracklabel) if (routelength < 2) let $car(@Xcar,route) = $set(@rend,add,@xloc) let $car(@Xcar,note) = $set(@xloc,add,@rend) endif endwhile // update message and note. let message = @message + "> Engine routing data checked and verified.@cr@" note @message // ADJUST AND VERIFY THE XOCARS GRID READY FOR BASIC OPERATIONS // Obtain a list of all the XOcars on the layout. let ClistXO = $ao_dev(getset,cXO) // process all cars in the cXO set let templist = @clistxo while (templist<>"") // get each XO car in turn let xcar = $set(@templist,get,0) let templist = $set(@templist,remove,0) // eliminate any residue of Industry Row numbers from XO cars that were previously setup to use the Industries Grid. let $car(@xcar,IndRow) = "" // for each XO car get the aar, trackID, tracklabel and loadname let aar = $car(@xcar,aar) // check for aar override code let override = $car(@xcar,aaroverride) if (override <> "") let xaar = @override endif let Xtrack = $car(@xcar,track) let xlab = $car(@xcar,tracklabel) let loadname = $car(@xcar,loadname) // if the car is a baggage or passenger car and the shipment field is empty then apply a default loadname. let aar = $substr(0,1,@aar) if (aar=B) if ($car(@xcar,shipment)="") let $car(@xcar,shipment) = "Baggage" endif endif if (aar=P) if ($car(@xcar,shipment)="") let $car(@Xcar,shipment) = "Passengers" endif endif if (aar=C) if ($car(@xcar,shipment)="") let $car(@Xcar,shipment) = "Passengers" endif endif if (templist="") // update message and note. let message = @message + "> Basic XO car data checked and validated.@cr@" note @message @waitmessage endif endwhile // CHECK THE XO ROUTE DATA AGAINST THE SEQUENCE DATA FOR VALIDITY let S = $ops(find,seq.startat,all,startat) let E = $ops(find,seq.endat,all,endat) let V = $ops(find,seq.visits,all,visits) let V = $set(@V,union,@S) let V = $set(@V,union,@E) let V = $set(@V,flatten) let V = $set(@V,dedupe) let V = $set(@V,sort) let templist = @ClistXO while (templist<>"") let Xcar = $string(@templist,nexttoken,",") let Xroute = $car(@Xcar,route) // skip cars which have no Route if ($set(@Xroute,count) < 2) continue endif // identify route locations that don't exist In the Sequence grid let Y = $set(@Xroute,sort) let Y = $set(@Y,dedupe) let Y = $set(@Y,difference,"]]") let test = $set(@V,intersection,@Y) if (test <> @Y) let test = $set(@Y,difference,@V) // update message and note. let message = @message + "> Sequence grid has no train to move @Xcar to @test (Edit Sequence).@cr@" note @message endif endwhile // CHECK AND ADJUST XOCAR ROUTING AND XO CAR DATA CHECKS // Update or adjust the car properties on all the XO cars let tYards = $ao_dev(GetSet,tYards) let tAll = $ao_dev(getset,tAll) let Cenginesplus = $ao_dev(getset,cenginesplus) let templist = @ClistXO while (templist<>"") // Collect the current data from the car. let Xcar = $set(@templist,get,0) let templist =$set(@templist,remove,0) let Xlab = $car(@Xcar,tracklabel) let Xdest = $car(@Xcar,dest) let Xroute = $car(@Xcar,route) let Xnote = $car(@Xcar,note) let Xshipment = $car(@Xcar,shipment) let Xloadat = $car(@Xcar,loadat) let XindID = $car(@Xcar,indID) // Strip surplus leading spaces from any individual label in the route string. let xroute = $set(@xroute,union,@xroute) // Remove any outdated IndRow reference remaining on cars that were not previously classified as XO let $car(@Xcar,indrow) = "" // If the route field contains only a single label this is not a route so make it null. let count = $set(@Xroute,count) if (count=1) let Xroute="" endif // If the route field is null then set dest and note to current track position, set loadat to null. if (Xroute="") let $car(@Xcar,dest) = @Xlab let $car(@Xcar,note) = @Xlab let $car(@Xcar,loadat) = "" endif // if the car is not an engine, tender or caboose then check for a route, shipment commodity and loadat data if ($set(@cEnginesplus,contains,@xcar)=0) if (@Xshipment="Spacer") continue endif if (@Xroute="") // update message and note. let message = @message + "> @xcar requires data in the Route column. (Unless it is a Spacer or MOW car).@cr@" note @message endif if (@Xshipment="") // update message and note. let message = @message + "> @xcar requires a loadname in the Shipment column (use na or mt for MOW/Spacer cars).@cr@" note @message let $car(@Xcar,shipment)=@Xshipment let $car(@Xcar,loadname)="mt" endif if (Xloadat="") // update message and note. let message = @message + "> @xcar requires the loadat position(s) specifying (Unless it is a Spacer or MOW car).@cr@" note @message endif // The loadat position must be a valid part of the car's route. let Xtemp = @Xloadat while (Xtemp<>"") let X = $set(@Xtemp,get,0) let Xtemp = $set(@Xtemp,remove,0) if ($set(@Xroute,contains,@X)=0) // update message and note. let message = @message + "> @xcar loadat @X position is not part of this car's route: @Xroute@.@cr@" note @message endif if ($set(@tAll,contains,@X)=0) // update message and note. let message = @message + "> @xcar loadat @X position is not a valid track label for this layout.@cr@" note @message endif if ($set(@tYards,contains,@X)=1) // update message and note. let message = @message + "> @xcar loadat @X position is not valid, cars cannot be loaded in a Classification Yard.@cr@" note @message endif endwhile endif // If current end position doesn't match the car location and doesn't end in ]] add current spot to end of the route if ($string(@Xroute,endswith,@Xlab)=0) if ($string(@Xroute,endswith,"]]")=0) let Xroute = $set(@Xroute,add,@Xlab) endif endif // If the car is a routed car ensure the end position preceding the ]] matches the current position of the car if ($set(@Xroute,contains,"]]")=1) let X = $set(@Xlab,add,"]]") if ($string(@Xroute,endswith,@X)=0) let count = $set(@Xroute,count) let count = @count - 1 let Xroute = $set(@Xroute,remove,@count) let Xroute = $set(@Xroute,add,@Xlab) let Xroute = $set(@Xroute,add,"]]") // If the current position is shown at the start of the route then remove it if ($string(@Xroute,startswith,@X)=1) let Xroute = $set(@Xroute,remove,0) let Xroute = $set(@Xroute,remove,0) endif if ($string(@Xroute,startswith,"]]")=1) let Xroute = $set(@Xroute,remove,0) endif endif endif // If there is a route it must not start with the current position of the car // remove current location from start of route if it appears there. let X = @Xlab if ($string(@Xroute,startswith,@X)=1) let Xroute = $set(@Xroute,remove,0) endif // Put the updated routing data back onto the car let $car(@Xcar,route) = @Xroute let $car(@Xcar,dest) = @Xlab let $car(@Xcar,note) = @Xroute // If the route contains an invalid track label then report it for editing. let xtemp = @Xroute // remove any instances of ]] from the route while ($set(@xtemp,contains,"]]")=1) let xtemp = $set(@xtemp,difference,"]]") endwhile while (xtemp<>"") let X = $set(@xtemp,get,0) let xtemp = $set(@xtemp,remove,0) if ($set(@tAll,contains,@X)=0) // update message and note. let message = @message + "> Car @xcar has an invalid route. Location @X does not exist on this layout.@cr@" note @message endif endwhile if (templist="") // update message and note. let message = @message + "> Completed Routing and Shipment data checks.@cr@" note @message endif endwhile /* REMOVED THIS CODE IS NO LONGER NEEDED AS THE SWITCHLIST IS STILL TO BE GENERATED // MODIFY THE NOTE FIELD FOR XO CARS WHICH ARE PART OF THE FIRST TRAIN. let Xcar = $ops(get,sequence.engine,1) let Xtrain = $train(@Xcar,carlabels) let Xtrain = $set(@Xtrain,intersection,@ClistXO) while (Xtrain <> "") let X = $string(@Xtrain,nexttoken,",") let Xroute = $car(@X,route) let Xnote = $car(@X,note) if (Xroute = @Xnote) ; if(Xroute<>"") let Y = $string(@Xnote,nexttoken,",") let $car(@X,dest) = @Y let Xnote = $set(@Xnote,add,@Y) let $car(@X,note) = @Xnote // update message and note. let message = @message + "> Updated Dest and Note data for car @X to run on the first train.@cr@" note @message endif ; endif endwhile */ // REFRESH THE VIEW TO TAKE ACCOUNT OF ANY AUTO CORRECTIONS MADE TO THE XO CAR PROPERTIES view refresh // UPDATE NOTEBOX notebox Edit the XO cars grid if necessary before continuing the FixOps process. // DISPLAY XO CAR GRID TO ENABLE USER EDITING //refresh the grid to display any fixops changes to xo car props data call $ops(show,xo cars) // Update message and note. let message = @message + @cr + "YOU CAN EDIT THE XO CARS GRID IF NECESSARY (OPTIONAL)@cr@" let message = @message + "> Restrict editing to the Route, Shipment and LoadAt columns only.@cr@" let message = @message + "> The other columns should not be modified.@cr@" let message = @message + "> Routes should end with the car's current location (or location and ]] marker).@cr@" note @message // UPDATE SAVED MESSAGE TO INCLUDE LATEST XO CARS GRID MESSAGES let savedmessage = @savedmessage + @message + @cr // GET USER INPUT call $msgbox("Optionally Edit the XO cars grid and apply the changes. Then click OK here to continue the FixOps process.") call $ops(hide,ops) // ============================================================================== // UPDATE NOTEBOX notebox Generating switchlist and saving layout to disk // GENERATE A NEW FIRST SWITCHLIST. call $ao_dev(dev,"Generate first") // update message and note. let message = "PREPARING LAYOUT FOR ADVANCED OPS" + @cr let message = @message + "> Generated a new first Switchlist." + @cr note @message // ADJUST FILENAME TO INCLUDE _AO SUFFIX IF NECESSARY // get the current pathname and test for the _ao suffix let pathname = $layout(path) if ($string(@pathname,endswith,"_ao.rrw")=1) // we are OK to update the original _ao file. elseif ($string(@pathname,endswith,"_ops.rrw")=1) // we are OK to update the original _ops file. else // truncate the pathname to remove the .rrw extension. let length = $string(@pathname,length) let length = @length - 4 // add a _ops suffix to the pathname prior to saving. let pathname = $substr(0,@length,@pathname) let pathname = @pathname + "_ops.rrw" endif // SAVE THE MODIFIED LAYOUT BACK TO THE ORIGINAL FOLDER. file "save as" @pathname // shorten the pathname for the displayed message note let x = $findstr(layouts,@pathname) let tempname = $substr(@x,-1,@pathname) // OPEN SWITCHLIST call $ops(show,switchlist) // UPDATE NOTEBOX notebox Review the Switchlist grid before continuing. // UPDATE MESSAGE AND NOTE. let message = @message + "> Checked or fixed file pathname to use the _ops suffix." + @cr let message = @message + "> Layout saved as @tempname@." + @cr let message = @message + "> Your layout should now be ready to operate." + @cr let message = @message + "> You should run FixOps again if you make any changes to the layout." + @cr let message = @message + "> A summary of the completed FixOps tasks is now available in the Schedule window." + @cr let message = @message + "> This switchlist grid is 'Read only' and can't be edited." + @cr note @message // GET USER INPUT call $msgbox("The Switchlist tab is for information only and can't be edited. Click OK here to review the FixOps processes.") // HIDE THE SWITCHLIST AND DISPLAY THE INTRODUCTION TAB call $ops(hide,switchlist) call $ops(show,intro) // UPDATE NOTEBOX notebox Finalizing the FixOps process. // UPDATE SAVED MESSAGE TO INCLUDE LATEST FINALIZATION MESSAGES let savedmessage = @savedmessage + @message + @cr // SEND SUMMARY OF WORK DONE TO THE SCHEDULE WINDOW FOR ANALYSIS call $view(show,schedule) echo CLS echo SUMMARY OF FIXOPS REPORT FOR $layout @cr echo @savedmessage echo FIXOPS PROCESS IS COMPLETE - YOUR LAYOUT IS NOW READY TO OPERATE // FINAL NOTE note FIXOPS PROCESS IS COMPLETE - YOUR LAYOUT IS NOW READY TO OPERATE @cr // GET USER INPUT call $msgbox("THE FIXOPS PROCESS IS NOW COMPLETE - YOUR LAYOUT IS READY TO OPERATE @cr @cr@Click here to close the Schedule Window and operate your layout.") // CLOSE SCHEDULE WINDOW call $view(hide,schedule) call $ops(hide,intro) // CLEAR LAST NOTE & NOTEBOX note notebox // End of subroutine "FixOps". RF 190426. Updated 221130. // Completely revised and rewritten for TrainPlayer 8.3 RF 240421 // ===========================================================================