- Tue Nov 17, 2015 7:00 pm
#34361
The code below evolved from the mid 80's and the company folded in the 90's....but the code has some uses......
This was written to run on 8bit DOS PC's with 256K or 512K of Ram........(before that BBC Micro......)
Some of the routines can be of use to understand the "basics"..............
This was written to run on 8bit DOS PC's with 256K or 512K of Ram........(before that BBC Micro......)
Some of the routines can be of use to understand the "basics"..............
Code: Select all
' test1 v1.07 Rev B test22 6-10-89 test23 18-6-91 test26 2-6-92June
' original 10-5-89 27 27-11-92 28 27-11-92 29 1-2-94
' mods to SelfTest 27-11-92 28 remove LoadFromCable 386ct 15-6-94
' with Operator number
' with LPRINT USING imp$
' with Nodes which start at 1 (not zero)
' modified 5-7-89 to correct for Amstrad timing (test19)
' with mods 6-10-89 (LoadFromDisc, EditLoom and TestCable - test22)
' mods 11-6-90 to GetNodeNames (Lines 628 -631)
' with mods 18-6-91 256 node-lines 121,160 and 323 (+SenseBoard * 128)
' OPEN "COM1:1200,N,8,1" AS 2 LEN = 1 removed 1st Feb 1994
DEFINT C,P,S
OPTION BASE 1
DIM CableGood(1500,2),CableTest(1500,2),Conns(8),NoSame%(200,2)
DIM NodeNumber%(512),NodeName$(512)
PortA=&h1b4 : PortB=&h1b5 : PortC=&h1b6
ControlReg = &H1b7 : Port2Control=&h90:
MaxNodes% = 512
Dollar$ = "$": Spare% = 123: GoodData% = 0: Count = 0: Connections = 0:First=1
CLS
CALL Frame
CALL OpNum
CLS
WHILE Choice < 9
CALL Frame
CALL Menu
PRINT "Choice was ";Choice
SELECT CASE Choice
CASE 1: ' CALL LoadFromCable
CASE 2: CALL SaveToDisc
CASE 3: CALL LoadFromDisc
CASE 4: CALL TestCable
CASE 5: CALL PrintConnections
CASE 6: CALL SelfTest
CASE 7: CALL EditLoom
CASE 8: CALL DiscInfo
CASE 9: CLS: PRINT "Leaving the Assembly tester"
END SELECT
WEND
END
SUB OpNum
SHARED OpNum
LOCATE 2,10: PRINT "Type in your user number - a 4 digit number";
DO
INPUT OpNum
IF OpNum < 1 OR OpNum > 32000 THEN PRINT "Enter again"
LOOP UNTIL OpNum > 0 AND OpNum < 32001
END SUB ' OpNum
SUB Menu
SHARED Choice,OpNum
LOCATE 2,10: PRINT "Kinloch Electronics Ltd"
LOCATE 2,55: PRINT "Operator Number: ";OpNum
LOCATE 3,10: PRINT "Assembly Tester"
' LOCATE 4,25: PRINT "1 Load from cable "
LOCATE 6,25: PRINT "2 Save to disc"
LOCATE 8,25: PRINT "3 Load from disc"
LOCATE 10,25: PRINT "4 Test cable"
LOCATE 12,25: PRINT "5 Print connections"
LOCATE 14,25: PRINT "6 Self test"
LOCATE 16,25: PRINT "7 Edit loom"
LOCATE 18,25: PRINT "8 Disc Information"
LOCATE 20,25: PRINT "9 Quit"
LOCATE 24,10: PRINT "Choose an option ";
DO
DO
Choice$ = INKEY$
LOOP UNTIL LEN(Choice$) > 0
Choice = ASC(Choice$) - 48: PRINT Choice
LOOP UNTIL Choice > 0 AND Choice < 10
END SUB ' Menu
SUB LoadFromCable
CLS: PRINT "Loading from cable"
SHARED CableGood(),Port2Control,ControlReg,PortA,PortB,PortC,GoodData%,Connections
SHARED PartNo$,Cable$,FirstNode%,EndNode%,NoSame%(),First
ERASE CableGood
First = 1
DO
DO
INPUT "What is the PartNumber of your assembly? - max 20 characters ",PartNo$
Length = LEN(PartNo$)
IF Length > 20 THEN PRINT "Too long - please enter again!"
LOOP UNTIL Length >0 AND Length <= 20
Cable$ = RIGHT$(PartNo$,8)
x = INSTR(Cable$," "): IF x <> 0 THEN Cable$ = RIGHT$(Cable$,8-x)
x = INSTR(Cable$," ")
IF x <> 0 THEN PRINT "You have spaces in the last 8 characters - enter again"
LOOP UNTIL x = 0
CLS: PRINT "Part Number ";PartNo$," stored as ";Cable$ ' :delay 1
OUT ControlReg, Port2Control
DO
PRINT "Test range now normally starts at 1. It is not allowed to be zero"
INPUT "Test range - from? ",FirstNode%
LOOP UNTIL FirstNode% > 0
DO
PRINT "End Node will need to be greater than First Node"
INPUT " to? ",EndNode%
LOOP UNTIL EndNode% > FirstNode%
DECR FirstNode%: DECR EndNode%
' ? "FirstNode = ";FirstNode%,"EndNode = ";EndNode%: delay 1
PRINT time$
Count = 0
FOR Source = FirstNode% TO EndNode%
SourceBoard = Source \ 128: SourceOutput = Source MOD 128
OUT PortB, SourceOutput
OUT PortC, SourceBoard * 64
' FOR g% = 1 TO 3 : NEXT g
FOR SenseBoard = FirstNode% \ 128 TO EndNode% \ 128
FOR Sense = 0 TO 15
OUT PortC, SourceBoard * 64 + SenseBoard * 16 + Sense
FOR g% = 1 TO 3 : NEXT g%
Innput% = INP(PortA)
IF Innput% <> 255 THEN
CALL AnalyseInput(Innput%,Conns())
FOR i% = 1 TO 8
IF Conns(i%) = 1 THEN
SensedNode = (i%-1)*16 + Sense + SenseBoard * 128
IF SensedNode > Source THEN
Count = Count + 1
CableGood(Count,1) = Source: CableGood(Count,2) = SensedNode
' ?CableGood(Count,1),CableGood(Count,2),Count
END IF
END IF
NEXT i%
END IF
NEXT Sense
NEXT SenseBoard
NEXT Source
PRINT Time$,Count
Connections = Count
IF Count > 0 THEN GoodData% = 1
IF Connections >1 THEN CALL SameNumber
IF NoSame%(1,1) <> 0 THEN CALL Sort
' delay 3:?
END SUB ' LoadFromCable
SUB GetConnections
SHARED CableTest(),Port2Control,ControlReg,PortA,PortB,PortC,ConnsTest
SHARED FirstNode%,EndNode%
OUT ControlReg,Port2Control
Count = 0
FOR Source = FirstNode% TO EndNode%
SourceBoard = Source \ 128: SourceOutput = Source MOD 128
OUT PortB, SourceOutput
OUT PortC, SourceBoard * 64
' FOR g = 1 TO 100 : NEXT g
FOR SenseBoard = FirstNode% \ 128 TO EndNode% \ 128
FOR Sense = 0 TO 15
OUT PortC, SourceBoard * 64 + SenseBoard * 16 + Sense
FOR g% = 1 TO 3 : NEXT g%
Innput% = INP(PortA)
IF Innput% <> 255 THEN
CALL AnalyseInput(Innput%,Conns())
FOR i% = 1 TO 8
IF Conns(i%) = 1 THEN
SensedNode = (i%-1)*16 + Sense + SenseBoard * 128
IF SensedNode > Source THEN
' PRINT Source,SensedNode
Count = Count + 1
CableTest(Count,1) = Source: CableTest(Count,2) = SensedNode
END IF
END IF
NEXT i%
END IF
NEXT Sense
NEXT SenseBoard
NEXT Source
ConnsTest = Count
END SUB ' GetConnections
SUB TestCable
SHARED CableGood(),GoodData%,Connections,NoSame%(),NodeName$(),NodeNumber%()
SHARED FirstNode%,EndNode%,PartNo$,CableTest(),ConnsTest,First,OpNum
ERASE CableTest
' N$ = SPACE$(9)
CLS: LOCATE 5,10: PRINT "Testing cable ";PartNo$," Operator Number ";OpNum
IF GoodData% <> 1 THEN
PRINT "You have nothing to test against"
PRINT "Choose 1 or 3 from Main Menu"
CALL AwaitKey
EXIT SUB
END IF
IF First = 1 THEN CALL GetNodeNames: INCR First
CALL GetConnections
IF ConnsTest > 1 THEN CALL SameNumberT
IF NoSame%(1,1) <> 0 THEN CALL SortT
' PRINT "ConnsTest = ";ConnsTest: delay 1
' FOR I% =1 TO ConnsTest: PRINT CableTest(I%,1),CableTest(I%,2): NEXT I%
Errors% = 0: Count = 1: CountTest = 0: EndGood = 0: EndTest = 0
IF ConnsTest = 0 THEN
FOR I% = 1 to Connections
CALL Namme(CableGood(I%,1),CableGood(I%,2),"Open ")
INCR Errors%
NEXT I%
END IF
IF ConnsTest > 0 THEN
DO
INCR CountTest
Source = CableTest(CountTest,1): SensedNode = CableTest(CountTest,2)
' LPRINT "CT= ";CountTest;" ";Count;" ";Source;" ";CableGood(Count,1);" ";SensedNode;" ";CableGood(Count,2)
IF Source=CableGood(Count,1) AND SensedNode=CableGood(Count,2) THEN
INCR Count
ELSEIF CableGood(Count,1) = 0 AND CableGood(Count,2) = 0 THEN
EndGood = 1: INCR Errors%
CALL Namme(Source,SensedNode,"Short")
ELSEIF Source<CableGood(Count,1) OR (Source=CableGood(Count,1) AND SensedNode<CableGood(Count,2)) THEN
INCR Errors%
CALL Namme(Source,SensedNode,"Short")
ELSEIF Source>CableGood(Count,1) OR (Source=CableGood(Count,1) AND SensedNode>CableGood(Count,2)) THEN
WHILE Source>CableGood(Count,1)OR (Source=CableGood(Count,1) AND SensedNode>CableGood(Count,2))
INCR Errors%
CALL Namme(CableGood(Count,1),CableGood(Count,2),"Open ")
INCR Count
IF CableGood(Count,1)=0 AND CableGood(Count,2)=0 THEN EndGood = 1:EXIT LOOP
WEND
IF EndGood = 1 THEN
INCR Errors%
CALL Namme(Source,SensedNode,"Short")
END IF
IF Source=CableGood(Count,1) AND SensedNode=CableGood(Count,2) THEN
INCR Count
ELSEIF Source<CableGood(Count,1) OR (Source=CableGood(Count,1) AND SensedNode < CableGood(Count,2)) THEN
INCR Errors%
CALL Namme(Source,SensedNode,"Short")
END IF
END IF
LOOP UNTIL CountTest = ConnsTest
INCR CountTest:Source =CableTest(CountTest,1):SensedNode=CableTest(CountTest,2)
IF Source = 0 AND SensedNode = 0 THEN
EndTest = 1
FOR I% = Count TO Connections
INCR Errors%:?"E ";Errors%
CALL Namme(CableGood(I%,1),CableGood(I%,2),"Open ")
NEXT I%
END IF
END IF
IF Errors% = 0 THEN PRINT "OK":BEEP ELSE PRINT "FAIL ": BEEP: BEEP
X$ = DATE$: Y$ = LEFT$(X$,2): Z$ = MID$(X$,4,2): W$ = RIGHT$(X$,5)
X$ = Z$+"-"+Y$+W$
ON ERROR GOTO PtrrErr
Ptrr:
IF Errors% > 0 THEN
LPRINT X$
LPRINT Time$
LPRINT "Assembly ";PartNo$
LPRINT "Operator Number: ";OpNum
LPRINT: LPRINT: LPRINT: LPRINT: LPRINT: LPRINT: LPRINT: LPRINT
END IF
ON ERROR GOTO 0
IF Errors% = 1 THEN
PRINT "There is ";Errors%;" error"
ELSEIF Errors% > 1 THEN
PRINT "There are ";Errors%;" errors"
END IF
Delay 1: ' CALL AwaitKey
END SUB ' TestCable
PtrrErr:
IF ERR = 25 OR ERR = 27 THEN
PRINT "There is some problem with your printer"
PRINT "Please correct the problem and press any key when ready"
CALL AwaitKey
END IF
RESUME Ptrr
SUB Namme(Node1%,Node2%,OpOrSh$)
SHARED Nodes%,NodeNumber%(),NodeName$()
ip$ = "\ \,##,\ \,##,\ \"
Z%=0: N1$ = SPACE$(8)
FOR J% = 1 TO Nodes%
IF Node1% + 1 = NodeNumber%(J%) THEN Z%=J%: EXIT FOR
NEXT J%
IF Z%<>0 THEN RSET N1$=NodeName$(Z%) ELSE N1$ = " "
Z%=0: N2$ = SPACE$(8)
FOR J% = 1 TO Nodes%
IF Node2% + 1 = NodeNumber%(J%) THEN Z%=J%: EXIT FOR
NEXT J%
IF Z%<>0 THEN RSET N2$=NodeName$(Z%) ELSE N2$ = " "
ON ERROR GOTO PtrErr
Ptr:
LPRINT USING ip$;OpOrSh$,Node1% + 1,SPC(1),N1$,Node2% + 1,SPC(1),N2$
ON ERROR GOTO 0
END SUB ' Namme
PtrErr:
IF ERR = 25 OR ERR = 27 THEN
PRINT "There is a problem with your printer"
PRINT "Please correct the problem and press any key when ready"
CALL AwaitKey
END IF
RESUME Ptr
SUB SelfTest
SHARED CableGood(),Port2Control,ControlReg,PortA,PortB,PortC,GoodData%,Connections
CLS: Errors% = 0
OUT ControlReg, Port2Control
PRINT "Connect up a good harness and press any key when you are ready"
FirstNode% = 0: EndNode% = 255
FOR I% = 1 TO 64:CableGood(I%,1)= I%- 1:CableGood(I%,2)= I% + 63: NEXT I%
FOR I% = 65 TO 128:CableGood(I%,1)=I%+63:CableGood(I%,2)=I%+127: NEXT I%
'CableGood(1,1)=1: Simulate a faulty SelfTest by placing wrong number in array
CALL AwaitKey
PRINT time$
Count = 0
PRINT "Connections found":PRINT "Source Sense"
FOR Source = FirstNode% TO EndNode%
Conns = 0
SourceBoard = Source \ 128: SourceOutput = Source MOD 128
OUT PortB, SourceOutput: OUT PortC, SourceBoard * 64
FOR SenseBoard = FirstNode% \ 128 TO EndNode% \ 128
FOR Sense = 0 TO 15
OUT PortC, SourceBoard * 64 + SenseBoard * 16 + Sense
Innput% = INP(PortA)' : IF Innput% <> 255 THEN PRINT Innput%
IF Innput% <>255 THEN
CALL AnalyseInput(Innput%,Conns())
FOR i% = 1 TO 8
Ok = 0
IF Conns(i%) = 1 THEN
SensedNode = (i%-1)*16 + Sense + SenseBoard * 128
' PRINT Source,SensedNode
IF SensedNode > Source THEN
INCR Count: INCR Conns
' PRINT Source,CableGood(Count,1),SensedNode,CableGood(Count,2)
' INCR Count: INCR Conns removed 27-11-92
IF Source=CableGood(Count,1) AND SensedNode=CableGood(Count,2) THEN
Ok = 1 ' :?"Ok = ",Ok:?"Conns = ",Conns
ELSE
PRINT Source,CableGood(Count,1),SensedNode,CableGood(Count,2)
INCR Errors%
' PRINT "No. of errors = ";Errors%;" Error in Harness"
END IF
END IF
END IF
NEXT i%
END IF
NEXT Sense
NEXT SenseBoard
'IF Conns <> 1 THEN INCR Errors% :?"Errors% = ", Errors% removed 27-11-92
NEXT Source
IF Errors% = 0 AND Count < 128 THEN Errors% = 128 - Count
' ?"Errors = ";Errors%
PRINT Time$
IF Errors% = 0 THEN PRINT "Self Test successful":BEEP:BEEP ELSE PRINT "Fail"
delay 2
END SUB ' SelfTest
SUB AnalyseInput(Innput%,Conns(8))
Mask% = 128
FOR Bit% = 1 TO 8
y% = Innput% AND Mask%
IF y% = 0 THEN Conns(Bit%) = 1 ELSE Conns(Bit%) = 0
Mask% = Mask% / 2
NEXT Bit%
END SUB ' AnalyseInput
SUB SaveToDisc
SHARED Connections,CableGood(),GoodData%,PartNo$,Cable$,FirstNode%,EndNode%
CLS: PRINT "Saving to disc Assembly ";PartNo$;" - saved as ";Cable$
Dol$ = "$": Spare = 123
PRINT "Connections = ";Connections
IF GoodData% = 1 THEN
DiCable$ = "a:"+Cable$+".NOD" ' : PRINT DiCable$
Length = LEN(PartNo$): x$ = PartNo$: FOR I%=1 TO 4: A$(I%)="":NEXT I%
I% = 4
IF Length < 6 THEN
A$(i%) = PartNo$ ' : PRINT Length
ELSE
DO
A$(i%) = RIGHT$(x$,5)
IF Length > 5 THEN x$ = LEFT$(x$,Length - 5)
Length = LEN(x$) ' :?i%,PartNo$,x$,Length,A$(i%):delay 1
DECR i%
LOOP UNTIL Length <= 5
A$(i%) = x$
END IF
' PRINT "1 ";A$(1),"2 ";A$(2),"3 ";A$(3),"4 ";A$(4): CALL AwaitKey
ON ERROR GOTO DiscWriteError
DiscWrite:
OPEN DiCable$ FOR RANDOM AS 1 LEN = 5
FIELD 1, 2 AS NodeNumber1$, 2 AS NodeNumber2$, 1 AS Dollar$
FIELD 1, 2 AS Connections$, 2 AS Spare$, 1 AS Dollar$
FIELD 1,2 AS FirstNode$, 2 AS EndNode$, 1 AS Dollar$
FIELD 1,5 AS PartSection$
LSET Spare$ = MKI$(Spare): LSET Dollar$ = Dol$
FOR I% = 1 TO 4
RSET PartSection$ = A$(I%) ' :?PartSection$,I%
PUT 1, I%
NEXT I%
LSET FirstNode$ = MKI$(FirstNode%) ' not CableGood(1,1))
LSET EndNode$ = MKI$(EndNode%) ' not CableGood(Connections,2))
PUT 1,5
LSET Connections$ = MKI$(Connections)
PUT 1,6
FOR I% = 1 TO Connections
LSET NodeNumber1$ = MKI$(CableGood(I%,1))
LSET NodeNumber2$ = MKI$(CableGood(I%,2))
PUT 1, I% + 6
NEXT I%
CLOSE 1
ON ERROR GOTO 0
ELSE
PRINT "You haven't any good data to save - Select Option 1 from menu"
' Delay 2
END IF
CALL AwaitKey
END SUB ' SaveToDisc
DiscWriteError:
IF ERR = 71 THEN
PRINT "Your disc is not in or the door is not shut"
PRINT "Correct the problem and press any key when ready"
CALL AwaitKey
END IF
RESUME DiscWrite ' DiscWriteError
SUB LoadFromDisc
CLS:PRINT "Loading from disc"
SHARED Connections,CableGood(),GoodData%,FirstNode%,EndNode%,PartNo$,First
ON ERROR GOTO DiscReadError
ERASE CableGood
First = 1
DO
DO
CLS
PRINT "You must enter the name that your assembly has been saved with"
PRINT "If the Part Number has 8 or less characters use it"
PRINT "If the Part Number has up to 20 characters it will be the last 8 of them"
PRINT "However there must be no spaces in the name"
INPUT "What name is your cable stored as? ",Cable$
Length = LEN(Cable$)
IF Length > 8 THEN PRINT "Too long - please enter again!"
LOOP UNTIL Length >0 AND Length <= 8
x = INSTR(Cable$," "): IF x <> 0 THEN Cable$ = RIGHT$(Cable$,8-x)
x = INSTR(Cable$," ")
IF x <> 0 THEN PRINT "You have one or more spaces in the name - enter again!"
LOOP UNTIL x = 0
DiCable$ = "a:"+Cable$+".NOD" : PRINT DiCable$ ' : CALL AwaitKey
DiscRead:
OPEN DiCable$ FOR RANDOM AS 1 LEN = 5
PRINT "Length of the file ",DiCable$," is ",LOF(1)
FIELD 1, 2 AS NodeNumber1$, 2 AS NodeNumber2$, 1 AS Dollar$
FIELD 1, 2 AS Connections$, 2 AS Spare$, 1 AS Dollar$
FIELD 1, 2 AS FirstNode$, 2 AS EndNode$, 1 AS Dollar$
FIELD 1,5 AS PartSection$
IF LOF(1) > 0 THEN
PartNo$ = ""
FOR I% = 1 TO 4
GET 1, I%
A$(I%) = PartSection$ :?PartSection$,I%
PartNo$ = PartNo$ + A$(I%)
NEXT I%
GET 1,5
FirstNode% = CVI(FirstNode$)
EndNode% = CVI(EndNode$) ' :?FirstNode%,EndNode%
GET 1,6
Connections = CVI(Connections$) ' :?Connections
FOR I% = 1 TO Connections
GET 1, I% + 6
CableGood(I%,1) = CVI(NodeNumber1$)
CableGood(I%,2) = CVI(NodeNumber2$)
NEXT I%
CLOSE 1
ELSE
PRINT "The name you have chosen does not exist - ",DiCable$
ON ERROR GOTO KillError
KILL DiCable$
CLOSE 1
AfterKill:
ON ERROR GOTO 0
END IF
ON ERROR GOTO 0
PRINT "Your harness has ";Connections;" connections "
PRINT "It's Part Number is ";PartNo$," saved as ";Cable$
' PRINT "Source Sense"
' FOR i% = 1 TO Connections
' PRINT CableGood(i%,1),CableGood(i%,2)
' NEXT i%
delay 1
IF Connections > 0 THEN GoodData% = 1
END SUB ' LoadFromDisc
KillError:
PRINT "Error in deleting file"
RESUME AfterKill 'KillError
DiscReadError:
IF ERR = 71 THEN
PRINT "Your disc is not in or the door is not shut"
PRINT "Correct the problem and press any key when ready"
CALL AwaitKey
END IF
RESUME DiscRead ' DiscReadError
SUB SameNumber
SHARED Connections,CableGood(),NoSame%()
' FOR I%=1 TO Connections:?CableGood(I%,1),CableGood(I%,2):NEXT I%:delay 2
Number% = 1: Same% = 0: I% = 1: Temp% = CableGood%(1,1): Poss% = 2
' ?"Same"
DO
INCR I%
WHILE CableGood(I%,1) = Temp%
INCR Number%: INCR I%: Same% = 1
' ? Number%,I%
WEND
' ?"afte wend",Number%,I%
IF Same% = 1 THEN
' ?Same%,Temp%,Number%
NoSame%(Poss%,1) = Temp%
NoSame%(Poss%,2) = Number%
Same% = 0: Number% = 1: INCR Poss%
END IF
Temp% = CableGood(I%,1) ' : INCR I%
' ?"I%= ";I%,Connections,"loop next"
LOOP UNTIL I% = Connections + 1
NoSame%(1,1) = Poss% - 2 ' spare space at NoSame%(1,2)
' ?:FOR I%=1 TO NoSame(1,1) + 1:?NoSame%(I%,1),NoSame(I%,2):Next I%: delay 3
END SUB ' SameNumber
SUB SameNumberT
SHARED ConnsTest,CableTest(),NoSame%()
Number% = 1: Same% = 0: I% = 1: Temp% = CableTest%(1,1): Poss% = 2
' ?"SameT"
DO
INCR I%
WHILE CableTest(I%,1) = Temp%
INCR Number%: INCR I%: Same% = 1
WEND
IF Same% = 1 THEN
NoSame%(Poss%,1) = Temp%
NoSame%(Poss%,2) = Number%
Same% = 0: Number% = 1: INCR Poss%
END IF
Temp% = CableTest(I%,1) ' : INCR I%
LOOP UNTIL I% = ConnsTest + 1
NoSame%(1,1) = Poss% - 2 ' spare space at NoSame%(1,2)
' FOR I% = 1 TO NoSame%(1,1) + 1:?NoSame%(I%,1),NoSame%(I%,2):NEXT I%:delay 3
END SUB ' SameNumberT
SUB Sort
SHARED Connections,CableGood(),NoSame%()
I% = 1: Poss% = 2
' ?"Sort"
DO
IF CableGood(I%,1) = NoSame%(Poss%,1) THEN
FOR J% = 1 TO NoSame%(Poss%,2)
FOR K% = NoSame%(Poss%,2) TO J% + 1 STEP - 1
IF CableGood(I% - 1 + K% - 1, 2) > CableGood(I% - 1 + K%, 2) THEN
SWAP CableGood(I% - 1 + K% - 1, 2), CableGood(I% - 1 + K%, 2)
END IF
NEXT K%
NEXT J%
I% = I% + NoSame%(Poss%,2): INCR Poss%
ELSE
INCR I%
END IF
LOOP UNTIL I% > Connections
' FOR I% = 1 TO Connections:?CableGood(I%,1),CableGood(I%,2):NEXT I%:delay 1
END SUB ' Sort
SUB SortT
SHARED ConnsTest,CableTest(),NoSame%()
I% = 1: Poss% = 2
' ?"SortT"
DO
IF CableTest(I%,1) = NoSame%(Poss%,1) THEN
FOR J% = 1 TO NoSame%(Poss%,2)
FOR K% = NoSame%(Poss%,2) TO J% + 1 STEP - 1
IF CableTest(I% - 1 + K% - 1, 2) > CableTest(I% - 1 + K%, 2) THEN
SWAP CableTest(I% - 1 + K% - 1, 2), CableTest(I% - 1 + K%, 2)
END IF
NEXT K%
NEXT J%
I% = I% + NoSame%(Poss%,2): INCR Poss%
ELSE
INCR I%
END IF
LOOP UNTIL I% > ConnsTest
' FOR I% = 1 TO ConnsTest:?CableTest(I%,1),CableTest(I%,2):NEXT I%:delay 1
END SUB ' SortT
SUB PrintConnections
SHARED Connections,CableGood(),NodeNumber%(),NodeName$(),Nodes%,PartNo$
ip$ = "###,\ \,###,\ \"
CLS: CALL GetNodeNames
CLS: BEEP: PRINT "Check your printer - power on, ON LINE and paper inserted."
CALL AwaitKey
LOCATE 10,15: PRINT "Printing connections for Assembly ";PartNo$
ON ERROR GOTO PrinterError
Printer:
X$ = DATE$: Y$ = LEFT$(X$,2): Z$ = MID$(X$,4,2): W$ = RIGHT$(X$,5)
X$ = Z$ + "-" + Y$ + W$
LPRINT "Date ";X$ ' Date$
LPRINT "Time ";Time$
LPRINT "Assembly ";PartNo$
LPRINT Connections;" Connections"
FOR I% = 1 TO Connections
Z% = 0: Z$=""
FOR J%= 1 TO Nodes%
IF CableGood(I%,1) + 1 = NodeNumber%(J%) THEN Z% = J%: EXIT FOR
NEXT J%
IF Z% <> 0 THEN Z$ = NodeName$(Z%) ELSE Z$ = " "
Z% = 0: Y$=""
FOR J%= 1 TO Nodes%
IF CableGood(I%,2) + 1 = NodeNumber%(J%) THEN Z% = J%: EXIT FOR
NEXT J%
IF Z% <> 0 THEN Y$ = NodeName$(Z%) ELSE Y$ = " "
LPRINT USING ip$;CableGood(I%,1) + 1,SPC(1),Z$,CableGood(I%,2) + 1,SPC(1),Y$
NEXT I%
LPRINT: LPRINT: LPRINT: LPRINT
ON ERROR GOTO 0
END SUB ' PrintConnections
PrinterError:
IF ERR = 25 OR ERR = 27 THEN
PRINT "Your printer is not switched on or it is out of paper"
PRINT "Correct the problem and press any key when ready"
CALL AwaitKey
END IF
RESUME Printer 'PrinterError
SUB GetNodeNames
SHARED NodeNumber%(),NodeName$(),Nodes%,PartNo$,Cable$
?"Partno is ";PartNo$;",";LEN(PartNo$)," Cable$ is ";Cable$
ON ERROR GOTO DiscReadError2
Cable$ = RIGHT$(PartNo$,8)
DO
x = INSTR(Cable$," "):xx = LEN(Cable$)
IF x <> 0 THEN Cable$=RIGHT$(Cable$,xx - x)
LOOP UNTIL x = 0
DiCable$ = "a:" + Cable$ + ".NAM"
' ?"DiCable$ ";DiCable$, LEN(DiCable$): Call AwaitKey
DiscRead2:
OPEN DiCable$ FOR RANDOM AS 1 LEN = 10
?" lof ";LOF(1)
FIELD 1, 2 AS NodeNumber$, 8 AS N$
FIELD 1, 2 AS Nodes$,8 AS CableName$
GET 1, 1
Nodes% = CVI(Nodes$)
IF Nodes% = 0 THEN LOCATE 10,10: PRINT "No node names available for this assembly"
FOR I% = 1 TO Nodes%
GET 1, I% + 1
NodeNumber%(I%) = CVI(NodeNumber$)
NodeName$(I%) = N$
PRINT NodeNumber%(I%),NodeName$(I%)
NEXT I%
CLOSE 1
ON ERROR GOTO 0
END SUB ' GetNodeNames
DiscReadError2:
IF ERR = 71 THEN
PRINT "Your disc is not in or the door is not shut"
PRINT "Correct the problem and press any key when ready"
CALL AwaitKey
END IF
RESUME DiscRead2 ' DiscReadError
SUB AwaitKey
WHILE NOT INSTAT
LOCATE 15,10:PRINT "Press the SPACE BAR to continue"
WEND
X$ = INKEY$
END SUB ' AwaitKey
SUB EditLoom
SHARED NodeNumber%(),NodeName$(),MaxNodes%
CLS: PRINT "EditLoom"
DO
INPUT "What is the name of your cable? (8 characters - no spaces! ",CableName$
LOOP UNTIL LEN(CableName$) < 9 AND INSTR(CableName$," ") = 0
D$ = "a:"+CableName$+".NOD"
DiCable$ = "a:"+CableName$+".NAM"
OPEN D$ FOR RANDOM AS 1 LEN = 5
IF LOF(1) > 0 THEN
CLOSE 1
ON ERROR GOTO DiscReadError3
DiscRead3:
OPEN DiCable$ FOR RANDOM AS 1 LEN = 10
FIELD 1, 2 AS NodeNumber$, 8 AS N$
FIELD 1, 2 AS Nodes$,8 AS CableName$
GET 1, 1
Nodes% = CVI(Nodes$):?" length of file "; LOF(1);" Nodes ";Nodes%
FOR I% = 1 TO Nodes%
GET 1, I% + 1
NodeNumber%(I%) = CVI(NodeNumber$)
NodeName$(I%) = N$
NEXT I%
CALL Layout(Nodes%,NodeName$(),NodeNumber%())
Number% = 1
' PRINT " Do not start with number zero - 0"
' PRINT " If you need to enter zero start with the next one, then the zero"
DO WHILE Number% <> 999
DO
LOCATE 21,28: PRINT " ";
LOCATE 21,10: INPUT "Number? 999 to end ",Number ' not a mistake!
IF Number > 32000 THEN
LOCATE 24,40: PRINT "Number far too big !";: BEEP: BEEP
Number% = 513
ELSE
Number% = CINT(Number)
END IF
LOCATE 24,40: PRINT " ";
IF Number% < 1 OR Number% > 512 AND Number% <> 999 THEN
LOCATE 24,40: PRINT "Number out of range - enter again";: BEEP
END IF
LOOP UNTIL (Number% >= 1 AND Number% < MaxNodes%) OR (Number% = 999)
IF Number% <> 999 THEN
DO
LOCATE 22,39: PRINT " ";
LOCATE 22,10: INPUT "Name? - maximum 8 characters ",Namme$
LOCATE 24,40: PRINT " ";
IF LEN(Namme$) > 8 THEN
LOCATE 24,40: PRINT "Name too long - enter again";: BEEP
END IF
LOOP UNTIL LEN(Namme$) < 9
END IF
Found = 0: Z% = 0
IF LEN(Namme$) = 0 AND Number% <> 999 THEN ' remove from array
FOR I% = 1 TO Nodes%
IF Number% = NodeNumber%(I%) THEN Z% = I%: EXIT FOR
NEXT I%
IF Z% <> 0 THEN
FOR I% = Z% TO Nodes%
NodeNumber%(I%) = NodeNumber%(I% + 1)
NodeName$(I%) = NodeName$(I% + 1)
NEXT I%
DECR Nodes%
' CALL Layout(Nodes%,NodeName$(),NodeNumber%())
END IF
END IF
IF Number% <> 999 AND LEN(Namme$) <> 0 THEN
IF Number% > NodeNumber%(Nodes%) THEN
INCR Nodes%: C = Nodes%
NodeNumber%(Nodes%) = Number%
NodeName$(Nodes%) = Namme$
ELSE
FOR I% = 1 TO Nodes%
IF Number% = NodeNumber%(I%) THEN
NodeNumber%(I%) = Number%
NodeName$(I%) = Namme$
C = I%: Found = 1
END IF
NEXT I%
IF Found = 0 THEN
FOR I% = 1 TO Nodes%
IF Number% < NodeNumber%(1) THEN Z% = 1:EXIT FOR
IF Number% > NodeNumber%(I%) AND Number% < NodeNumber%(I%+1) THEN Z%=I%+1
NEXT I%
FOR I% = Nodes% TO Z% STEP - 1
NodeNumber%(I% + 1) = NodeNumber%(I%)
NodeName$(I% + 1) = NodeName$(I%)
NEXT I%
NodeNumber%(Z%) = Number%
NodeName$(Z%) = Namme$
INCR Nodes%: C = Z%
' CALL Layout(Nodes%,NodeName$(),NodeNumber%())
END IF
END IF
Y% = C MOD 20
IF Y% = 0 THEN
Y% = 20: X% = (C \ 20 - 1) * 13 + 1
ELSE
X% = (C \ 20) * 13 + 1
END IF
LOCATE 23,60: PRINT " ": ' LOCATE Y%,X%: PRINT " "
LOCATE 23,60: PRINT Number%;Namme$: ' LOCATE Y%,X%: PRINT Number%;Namme$
END IF
LOOP
LOCATE 25,40: PRINT "Saving data ";
IF Nodes% > 1 THEN
LSET Nodes$ = MKI$(Nodes%): LSET C$ = CableName$
PUT 1,1
FOR I% = 1 TO Nodes%
LSET NodeNumber$ = MKI$(NodeNumber%(I%))
LSET N$ = NodeName$(I%)
PUT 1, I% + 1
NEXT I%
LOCATE 25,40: PRINT "Data saved ! ";
END IF
CLOSE 1
ELSE
PRINT "Deleting file ",D$
KILL D$
CLOSE 1
END IF
ON ERROR GOTO 0
END SUB ' EditLoom
DiscReadError3:
IF ERR = 71 THEN
PRINT "Your disc is not in or the door is not shut"
PRINT "Correct the problem and press any key when ready"
CALL AwaitKey
END IF
RESUME DiscRead3 ' DiscReadError
SUB Layout(N%,N$(1),No%(1))
CLS
' IF N% > 120 THEN N% = 119
Nx%=1: Col% = N% \ 20 + 1
FOR I% = 1 TO Col%
II% = I%: IF II% > 6 THEN II% = II% MOD 6
IF II% = 0 THEN II% = 6
IF I% = Col% THEN Row% = (N% MOD 120) MOD 20 ELSE Row% = 20
FOR J% = 1 TO Row%
LOCATE J%,(II%-1) * 13 + 1
PRINT No%(Nx%);N$(Nx%)
INCR Nx%
NEXT J%
NEXT I%
END SUB ' Layout
SUB DiscInfo
CLS: C = 0
LOCATE 8,25: PRINT "1 Node Connections Information"
LOCATE 12,25: PRINT "2 Node Name Information"
DO
INPUT C
LOOP UNTIL C > 0 AND C < 3
SELECT CASE C
CASE 1: CLS:
FILES "a:*.NOD"
CASE 2: CLS: FILES "a:*.NAM"
END SELECT
WHILE NOT INSTAT
LOCATE 23,25: PRINT "Press any key to continue"
WEND
X$ = INKEY$
END SUB ' DiscInfo
SUB Frame
Lt$ = CHR$(201): Rt$ = CHR$(187): Mt$ = CHR$(203): T$ = CHR$(205): Rm$ = CHR$(185)
Lb$ = CHR$(200): Rb$ = CHR$(188): Mb$ = CHR$(202): B$ = CHR$(205): Lm$ = CHR$(204)
V$ = CHR$(186): x$ = CHR$(206): h$ = STRING$(77,b$):B1$ = STRING$(77," ")
CLS
Line1$ = Lt$ + h$ + Rt$: PRINT Line1$
Line2$ = V$ + B1$ + V$: FOR I% = 1 TO 21: PRINT Line2$: NEXT I%
Line1$ = Lb$ + h$ + Rb$: PRINT Line1$
END SUB ' Frame
