!Draw Externals. Includes mods by DAK (commented as such). !copied across by JHB 27/5/85 %include "edwin:consts.inc" %include "edwin:specs.inc" %include "edwin:types.inc" %include "edwin:shapes.inc" %include "inc:Vtlib.imp" %include "Inc:Util.imp" %include "drawdec.inc" !--------------------------------------------------------------- %external %integer %array Menu(1:16)= 410,385,360,335,310,285, {Base of each of} 260,235,210,185,160,135, {menu locations} 75,50,25,5 %external %byte %array X Pnts(0:1680) = no(1681) {GRID.} %external %byte %array Y Pnts(0:1190) = no(1191) %external %integer End Program =no, Editing Symbol = no, Diag on = yes, Curr Colour, Curr Char Size, Curr Char Font, Curr Char Rot, Grid On = yes, Current Colour, Grid Interval=1000, Scale Line Length=30, V200X, V200Y, Scaling=1, VPXL, VPXR, VPYB, VPYT, {Viewport} DWXL, DWXR, DWYB, DWYT, {Drawing Window} VSXL, VSXR, VSYB, VSYT {Virtual Screen} %external %record(Symbol) Base Page Table=0, Base Symbol Table=0 %external %record(Symbol) %name Current Symbol, Current Page %external %routine Clear Screen clear frame %end %external %routine Move To(%integer X,Y) VT at(x,y) %end %external %routine printstring1(%string(255) S) %integer n %for n = 1,1,length(S) %cycle Printsymbol(Charno(S,n)) V200X = V200X +1 %repeat %end %external %routine newline1 %if V200Y < 22 %start V200X = 0 V200Y = V200Y +1 Move To(V200X,V200Y) %finish %else Scroll(12,22,1) %and V200X = 0 %end %external %routine Prstring(%string(255) string) %if Diag on = yes %then printstring1(string) %end %external %routine write1(%integer number,places) %if Diag on = yes %then write(number,places) %end %external %routine Newline2 %if Diag on = yes %then newline1 %end !--------------------------------------------------------------- %external %routine Enable All Planes enable reg = 2_1111 %end %external %routine Disable RBG planes enable reg = 2_1000 %end !-------------------------------------------------------------- %external %predicate L or R Pressed(%integer Status) %true %if Status = Left %or Status = right %false %end %external %predicate L or C or R Pressed(%integer Status) %true %if Status = Left %or Status = Centre %or Status = Right %false %end %external %predicate T to B(%integer oriY,endY) ! Prstring("T to B called"); newline2 %true %if oriY >= endY %false %end %external %predicate Vertical line(%integer oriX,endX) %true %if oriX = endX %false %end %external %predicate L to R(%integer oriX,endX) Prstring("L to R called"); newline2 write1(oriX,4); write1(endX,4); newline2 %true %if oriX < endX %false %end %external %predicate Horizontal line(%integer oriY,endY) Prstring("Horizontal line called"); newline2 write1(oriY,4); write1(endY,4); newline2 %true %if oriY = endY %false %end %external %predicate Between A and B(%integer Point,A,B) %true %if Point >= A %and Point <= B %false %end %external %predicate Point Chosen(%record(PointFM)Point) %true %if Point_X > 0 %and Point_Y > 0 %false %end %external %predicate In DW(%record(PointFM) Point) %byte In area = no %if Point_X >= DWXL %start %if Point_X <= DWXR %start %if Point_Y >= DWYB %start %if Point_Y <= DWYT %then In area = yes %finish %finish %finish %true %if In area = yes %false %end %external %predicate In VP(%record(PointFM) Point) %byte In area = no %if Point_X >= VPXL %start %if Point_X <= VPXR %start %if Point_Y >= VPYB %start %if Point_Y <= VPYT %then In area = yes %finish %finish %finish %true %if In area = yes %false %end %external %predicate Valid Font(%integer font) %if font < 65 %and font >1 %start %if font >= 8 %and font <= 10 %then %false %c %else %if font >= 18 %and font <= 22 %then %false %c %else %if font = 25 %then %false %c %else %if font >= 27 %and font <= 31 %then %false %c %else %if font >= 34 %and font <= 40 %then %false %c %else %if font >= 45 %and font <= 47 %then %false %c %else %if font = 49 %or font = 50 %then %false %c %else %if font >= 54 %and font <= 59 %then %false %true %finish %false %end !------------------------------------------------------------- %external %integer %function Max(%integer A,B) %integer result %if A > B %then result = A %else result = B %result = result %end %external %integer %function Min(%integer A,B) %integer result %if A < B %then result = A %else result = B %result = result %end %external %real %function Min1(%real A,B) %if A < B %then %result = A %else %result = B %end %external %byte %function Menu Item(%record(PointFM) Point) %byte n=0, found= no, result=0 %if Point_X > 0 %and Point_X < 139 %start %cycle n = n+1 %if Point_Y > Menu(n) %and Point_Y < Menu(n)+ 20 %start found = yes %finish %repeat %until found = yes %or n=16 %if found = yes %then result = n %finish %result = result %end %external %integer %function Text length(%string(80) Word) %integer oriX,oriY,endX,endY Prstring("Text length called"); newline2 Inquire Position(oriX,oriY) write1(oriX,5); write1(oriY,5); newline2 Enable reg = 2_10000 Text(Word) Enable All Planes Inquire Position(endX,endY) write1(endX,5); write1(endY,5); newline2 %result = endX - oriX %end %external %record(PointFM) %function Read Mouse %own %record(PointFM) Cursor=0, Last=0, Current Mouse=0 %integer relX, relY Current Mouse_X = MouseX Current Mouse_Y = MouseY %if Scaling > 1 %then %c Map to Virtual Coords(Current Mouse_X,Current Mouse_Y) relX = Current Mouse_X - Last_X relY = Current Mouse_Y - Last_Y Last = Current Mouse Cursor_X = Cursor_X + relX Cursor_Y = Cursor_Y + relY %if Cursor_X < VSXL %then Cursor_X = VSXR %else %c %if Cursor_X > VSXR %then Cursor_X = VSXL %if Cursor_Y < VSYB %then Cursor_Y = VSYT %else %c %if Cursor_Y > VSYT %then Cursor_Y = VSYB %result = Cursor %end !----------------------------------------------------------- %routine do round(%integer x, y, r) %integer e, s, da, db, dda, ddb, oda, odb, odda, oddb e = 1 s = 0 %cycle e = e<<1 s = s+1 %repeat %until e>r s = s+1 da = r<>s da = da-odb>>s %repeat %until da>s ddb = db>>s %exit %if ddb>=dda line(x+oddb,y+odda,x+ddb,y+dda) line(x+odda,y+oddb,x+dda,y+ddb) line(x+odda,y-oddb,x+dda,y-ddb) line(x+oddb,y-odda,x+ddb,y-dda) line(x-oddb,y-odda,x-ddb,y-dda) line(x-odda,y-oddb,x-dda,y-ddb) line(x-odda,y+oddb,x-dda,y+ddb) line(x-oddb,y+odda,x-ddb,y+dda) %repeat line(x+oddb,y+odda,x+odda,y+oddb) line(x+oddb,y-odda,x+odda,y-oddb) line(x-oddb,y-odda,x-odda,y-oddb) line(x-oddb,y+odda,x-odda,y+oddb) %end ! Character stuff %external %integerarray font(0:4999) ! The layout of the array is as follows: ! For 0<=i<=255, let p(i)=j ! p(j) is height of character i ! p(j+1) is width of character i ! p(j+2) to p(j+p(j)+1) describe the character %external %routine read font; ! Read in (one) font description %integer char,index,num,i,n,min,max,height=0 %integerfn reverse(%integer x) %integer n=0,y=16_80000000,c=16 %cycle n = n+y %if x&1#0 x = x>>1; y = y>>1; c = c-1 %repeatuntil c=0 %result=n %end openinput(3,"EDWIN:VISUAL.FNT") Select input (3) Prstring("font.visual opened"); newline2 font(i) = 256 %for i=0,1,255; !Default: null character font(256) = 0; font(257) = 0; !This is the null character index = 258; !This is where the rest starts Prstring("Line 165"); newline2 read(min); read(max) %for char=min,1,max %cycle readsymbol(num) %until num=':'; !Ignore character name font(char)=index read(num); font(index)=num; index=index+1 read(font(index)) %for i = num,-1,1 %cycle read(n); font(index+i) = reverse(n) %repeat height = num %if num>height; !Note highest character index = index+num+1 %repeat index = index-1 closeinput; selectinput(0) %end %external %integer xpos=0, ypos=0 %external %routine at(%integer x,y) xpos = x; ypos = y %end %external %routine showsymbol(%integer k) !DAK 18/05/85 This routine is a disaster area! ! only works with checks on! %option "-check-diag-line-stack" %integer q = addr(frame(0))+(ypos&1023)<<7+(xpos&1023)>>4<<1 %integer shiftcount = xpos&15 %integer p = addr(font(font(k&255)))+4 %integer height = integer(p-4) prstring("in showsymbol") xpos = xpos+integer(p) %returnif height=0 *move.l p,a0 *move.l q,a1 *move.l height,d0 *move.l (a0)+,d1; !width *moveq #-128,d2 *move.l shiftcount,d3 loop: *move.l (a0)+,d4 *lsr.l d3,d4 *move.l d4,(a1) *sub.l d2,a1 *move.l a1,d1 *=16_0881; *=17; !*bclr #17,d1 *move.l d1,a1 *subq #1,height *bgt loop prstring(" leaving showsymbol".SNL) %end %external %routine showstring(%string(255)s) %integer i showsymbol(charno(s,i)) %for i=1,1,length(s) %end %external %routine Clear Cursor Disable RBG Planes Set Colour(0) Fill(0,0,687,511) Enable All Planes %end %external %routine Clear Area(%integer XL,YB,XR,YT) Enable All Planes Set Colour(0) Fill(XL,YB,XR,YT) Set Colour(Curr Colour) %end %external %routine Clear Window Area(%integer XL,YB,XR,YT) %if XL < DWXL %then XL = DWXL %if XR > DWXR %then XR = DWXR %if YB < DWYB %then YB = DWYB %if YT > DWYT %then YT = DWYT Map to Device Coords(XL,YB) Map to Device Coords(XR,YT) Clear Area(XL,YB,XR,YT) %end %external %routine Clear Drawing Area Enable All Planes Set Colour(Blank) Fill(140,1,686,460) Set Colour(Curr Colour) %end %external %routine Clear Info Clear Area(130,491,647,510) %end %external %routine Clear Page name Clear Area(480,465,598,490) %end %external %routine Clear Page size Clear Area(600,465,647,490) %end %external %routine Clear Mouse Info Clear Area(50,465,147,490) Clear Area(190,465,287,490) Clear Area(330,465,427,490) %end %external %routine Clear Menu Clear Area(1,116,138,460) %end %external %routine Place Word(%string(255) Word,%integer X,Y) At(X,Y) Showstring(Word) %end %external %routine Display Info(%string(255) Info) Clear Info Set Colour(Lime) Place Word(Info,130,495) Set Colour(Curr Colour) ! Prstring(Info); newline2 ! Prstring("Display Info finished"); newline2 %end %external %routine Display name of page(%string(10) Page name) Clear Page name Set Colour(Lime) Placeword(Page name,480,465) Set colour(Curr Colour) %end %external %routine Display Page Size(%integer Size) Clear Page Size Set Colour(Lime) %if Size = A4 %then Placeword("A4",600,465) %else %c %if Size = Slide %then Placeword("Slide",600,465) %else %c %if Size = A3 %then Placeword("A3",600,465) Set Colour(Curr Colour) %end %external %routine Mouse Info(%String(10) L, C, R) Clear Mouse Info Set Colour(Lime) Place Word(L,50,470) Place Word(C,190,470) Place Word(R,330,470) Set Colour(Curr Colour) %end %external %routine Error Message(%string(255) message) %integer n Printsymbol(7) Display Info(message) %for n = 1,1,100000 %cycle %repeat Clear Info %end %external %routine Display Menu(%string(10) %array %name Words(1:12)) %integer n Clear Menu Set Colour(Yellow) %for n = 1,1,12 %cycle Placeword(Words(n),20,Menu(n)) %repeat Set Colour(Curr Colour) %end %external %routine Clear Input %integer dump %cycle readsymbol(dump) %repeat %until dump = nl %end %external %routine Read Text(%string(80) %name text) %string(1) SChar %byte dummy,Char,n=0, Next %on %event 1 %start Error Message("ERROR: Too many characters.") Clear Input %finish %cycle {Find first printable} Next = Nextsymbol {character.} %if Next <= 32 %or Next >= 127 %then %c Readsymbol(Next) %repeat %until Next > 32 %and Next < 127 n = 0 Text = "" %cycle n=n+1 readsymbol(Char) {Construct string from} SChar = To String(Char) {input} Text = Text.SChar Next = Nextsymbol %repeat %until Next = nl %or n = 80 %if Next # nl %and n =80 %start {Too many characters} Set Char font(0) Clear Cursor Error Message("ERROR: Line overflow") Clear Input %finish %end %external %routine Read from terminal(%string(80)%name string) Move To(1,9) Clear Line Read Text(string) Move To(V200X,V200Y) %end %external %routine Display Main menu %own %string(10) %array Main Menu(1:12) = "DRAW","DELETE","MOVE","COPY", "ZOOM","GRID","EDIT","DUPLICATE", "READ","SAVE","PDF","QUIT" Display Menu(Main Menu) %end %external %routine Box1(%integer BLX,BLY,TRX,TRY) Move Abs(BLX,BLY) Line Abs(BLX,TRY) Line Abs(TRX,TRY) Line Abs(TRX,BLY) Line Abs(BLX,BLY) %end %external %routine Box2(%integer XL,YB,XR,YT) Hline(XL,XR,YB) Hline(XL,XR,YT) Line(XL,YB,XL,YT) Line(XR,YB,XR,YT) %end %external %routine Swop(%integer %name end1,end2) %integer n ! Prstring("Swop called"); newline2 n = end1; end1 = end2; end2 = n %end %external %routine Delay %integer n %cycle n= Mouse Buttons & 2_111 %repeat %until n =0 %end %external %routine Map to Screen(%record(PointFM) %name Point) Map to Device Coords(Point_X,Point_Y) %end !------------------------------------------------------------ %external %routine Clear Grid %integer n n = 0 %while n <= 1190 %cycle X Pnts(n) = no Y Pnts(n) = no n = n + Grid Interval %repeat %while n <= 1680 %cycle X Pnts(n) = no n = n + Grid Interval %repeat %end %external %routine Set Grid %integer n n = 0 %while n <= 1190 %cycle X Pnts(n) = yes Y Pnts(n) = yes n = n + Grid Interval %repeat %while n <= 1680 %cycle X Pnts(n) = yes n = n + Grid Interval %repeat X Pnts(1680) = yes {Ensures can't go off end of arrays} Y Pnts(1190) = yes %end %external %routine Draw X Scale(%integer Colour,Interval) %integer n, Longer line, five spaces Prstring("Draw X Scale called"); newline2 write1(DWXL,5); write1(DWXR,5); newline2 Enable All Planes Set Colour(Colour) n = DWXL five spaces = 5 * Grid Interval Longer line = Int(Scale line length * 2) %while X Pnts(n) # yes %cycle n = n + 1 %repeat %while n < DWXR %cycle Move Abs(n,DWYB) %if Rem(n,five spaces) = 0 %then %c Line Rel(0,Longer Line) %else %c Line Rel(0,Scale Line Length) n = n + Interval %repeat Set Colour(Curr Colour) %end %external %routine Draw Y Scale(%integer Colour,Interval) %integer n, five spaces, Longer line Enable All Planes Set Colour(Colour) n = DWYB five spaces = 5 * Grid Interval Longer line = Int(Scale line length * 2) %while Y Pnts(n) # yes %cycle n = n + 1 %repeat %while n < DWYT %cycle Move Abs(DWXL,n) %if Rem(n,five spaces) = 0 %then %c Line Rel(Longer line,0) %else %c Line Rel(Scale Line Length,0) n = n + Interval %repeat Set Colour(Curr Colour) %end %external %routine Remove Grid Draw X Scale(0,Grid Interval) Draw Y Scale(0,Grid Interval) %end %external %routine Draw Grid Draw X Scale(1,Grid Interval) Draw Y Scale(1,Grid Interval) %end %external %routine Set to Grid Point(%record(PointFM) %name Point) %integer n =0 Prstring("Set to Grid Point called"); newline2 write1(Point_X,5); write1(Point_Y,5); newline2 %if Grid On = yes %start %cycle %if Point_X >= 0 %start %if Point_X >= 1680 %start Point_X = 1680 %finish %else %start %if X Pnts(Point_X + n) = yes %start Point_X = Point_X + n %exit %finish %if X Pnts(Point_X - n) = yes %start Point_X = Point_X - n %exit %finish n = n + 1 %finish %finish %repeat n = 0 %cycle %if Point_Y >= 0 %start %if Point_Y >= 1190 %start Point_Y = 1190 %finish %else %start %if Y Pnts(Point_Y + n) = yes %start Point_Y = Point_Y + n %exit %finish %if Y Pnts(Point_Y - n) = yes %start Point_Y = Point_Y - n %exit %finish n = n + 1 %finish %finish %repeat %if Point_X < DWXL %then Point_X = DWXL %else %c %if Point_X > DWXR %then Point_X = DWXR %if Point_Y < DWYB %then Point_Y = DWYB %else %c %if Point_Y > DWYT %then Point_Y = DWYT %finish %end !------------------------------------------------------------ %external %routine Reset Mouse(%integer Status) %if Status = 7 %start MouseX =0; MouseY =0 %finish %end %external %routine Confirm(%integer %name Status) %integer Stop Clear Mouse Info Mouse Info("YES"," ","NO") %cycle Stop = Mouse Buttons & 2_111 Reset Mouse(Stop) %repeat %until L or R Pressed(Stop) Status = Stop Delay Clear Mouse Info %end %external %routine Choose from(%integer %name Status,%string(10) ML,MC,MR) Mouse Info(ML,MC,MR) %cycle Status = Mouse Buttons & 2_111 Reset Mouse(Status) %repeat %until L or C or R Pressed(Status) Delay Clear Mouse Info %end %external %routine Draw Hairline(%record(PointFM) Point) Hline(VPXL,VPXR,Point_Y) Line(Point_X,VPYB,Point_X,VPYT) %end %external %routine Clear Hairline(%record(PointFM) Point) Set Colour(0) Draw Hairline(Point) %end %external %routine Hairline Cursor(%record(PointFM) Old, Cursor) Set Colour(8) Draw Hairline(Cursor) %if Cursor_X # Old_X %or Cursor_Y # Old_Y %start Set Colour(0) Draw Hairline(Old) %finish %end %external %routine Print Cross(%integer X,Y) %integer arm, L, B L = X - 8 B = Y - 8 %if L <= FVPXL %then Hline(FVPXL,L+16,Y) %else %c Hline(L,L+16,Y) %if B <= FVPYB %then Line(X,FVPYB,X,FVPYB+(16 - (FVPYB - B))) %else %c Line(X,B,X,B+16) %end %external %routine Draw Cursor(%record(PointFM) Point) Disable RBG planes Set colour(8) {write1 to Cursor plane} Print Cross(Point_X,Point_Y) %end %external %routine Clear Small Cursor(%record(PointFM) Point) Set Colour(0) Print Cross(Point_X,Point_Y) %end %external %routine Remove Hairline(%record(PointFM) Point) Map to Screen(Point) Clear Hairline(Point) %end %external %routine Remove Cursor(%record(PointFM) Point) Map to Screen(Point) Clear small cursor(Point) %end %external %routine Small Cursor(%record(PointFM) Old, Point) Set colour(8) {write1 to Cursor plane} Print Cross(Point_X,Point_Y) %if Point_X # Old_X %or Point_Y # Old_Y %start Set Colour(0) Print Cross(Old_X,Old_Y) %finish %end !%external %routine Clear top ! Clear Area(652,488,685,509) !%end ! !%external %routine Clear Bottom ! Clear Area(652,463,685,484) !%end ! !%external %routine Up Arrow(%integer X,Y) ! Line(X,Y-8,X,Y+8) ! Line(X,Y+8,X+4,Y+4) ! Line(X,Y+8,X-4,Y+4) !%end ! !%external %routine Down Arrow(%integer X,Y) ! Line(X,Y-8,X,Y+8) ! Line(X,Y-8,X-4,Y-4) ! Line(X,Y-8,X+4,Y-4) !%end ! !%external %routine Left Arrow(%integer X,Y) ! Hline(X-8,X+8,Y) ! Line(X-8,Y,X-4,Y-4) ! Line(X-8,Y,X-4,Y+4) !%end ! !%external %routine Right Arrow(%integer X,Y) ! Hline(X-8,X+8,Y) ! Line(X+8,Y,X+4,Y-4) ! Line(X+8,Y,X+4,Y+4) !%end ! !%external %routine Up Pointer ! Clear Bottom ! Set Colour(Lime) ! Up Arrow(669,474) !%end ! !%external %routine Down Pointer ! Clear Bottom ! Set Colour(Lime) ! Down Arrow(669,474) !%end ! !%external %routine Left Pointer ! Clear Top ! Set Colour(Lime) ! Left Arrow(669,499) !%end ! !%external %routine Right Pointer ! Clear Top ! Set Colour(Lime) ! Right Arrow(669,499) !%end %external %routine Ncircle(%integer X,Y,radius) %record(PointFM) C Point C Point_X = X + radius C Point_Y = Y Map to Device Coords(C Point_X,C Point_Y) Map to Device Coords(X,Y) radius = C Point_X - X %if radius <= 0 %then radius = 1 Do Round(X,Y,radius) %end %external %routine Cursor1(%record(PointFM) Point) %own %record(PointFM) Last = 0 %own %byte visible = no, In Window = no Disable RBG Planes %if In DW(Point) %start Map to Screen(Point) %if In window = no %start Clear Small Cursor(Last) In Window = yes %finish Hairline Cursor(Last,Point) %finish %else %start Map to Screen(Point) %if In window = yes %start Clear Hairline(Last) In Window = no %finish Small Cursor(Last,Point) %finish Last = Point %end ! %if Point_X <= VPXR %start ! %if Point_X >= VPXL %start ! %if Point_Y >= VPYB %start ! %if Point_Y <= VPYT %start ! %if Last_X < VPXL %then %c ! Clear small cursor(Last) ! Hairline Cursor(Last,Point) ! %if Visible = no %start ! Clear Top; Clear Bottom ! Visible = yes ! %finish ! %finish %else %start ! Clear Cursor ! Down Pointer ! Visible = no ! %finish ! %finish %else %start ! Clear Cursor ! Up Pointer ! Visible = no ! %finish ! %finish %else %if Point_X >= FVPXL %start ! %if Point_Y >= FVPYB %start ! %if Point_Y < FVPYT %start ! %if Last_X >= VPXL %then %c ! Clear Hairline(Last) ! Small Cursor(Last,Point) ! %if Visible = no %start ! Clear Top; Clear Bottom ! Visible = yes ! %finish ! %finish %else %start ! Clear small cursor(Last) ! Down Pointer ! Visible = no ! %finish ! %finish %else %start ! Clear small cursor(Last) ! Up Pointer ! Visible = no ! %finish ! %finish %else %start ! %if Point_Y >= FVPYT %start ! Clear small cursor(Last) ! Down Pointer ! Right Pointer ! Visible = no ! %finish %else %if Point_Y <= FVPYB %start ! Clear small cursor(Last) ! Up Pointer ! Right Pointer ! Visible = no ! %finish %else %start ! Clear small cursor(Last) ! Right Pointer ! Visible = no ! %finish ! %finish ! %finish %else %start ! %if Point_Y >= FVPYT %start ! Clear Hairline(Last) ! Down Pointer ! Left Pointer ! Visible = no ! %finish %else %if Point_Y <= FVPYB %start ! Clear Hairline(Last) ! Up Pointer ! Left Pointer ! Visible = no ! %finish %else %start ! Clear Hairline(Last) ! Left Pointer ! Visible = no ! %finish ! %finish ! Last = Point !%end %external %routine Show Cursor(%integer %name Button, %record(PointFM) %name Point) %own %record(PointFM) Mouse Posn %integer Stop %cycle Mouse Posn = Read Mouse Cursor1(Mouse Posn) Stop = Mouse Buttons & 2_111 Reset Mouse(Stop) %repeat %until L or C or R Pressed(Stop) Button = Stop Point = Mouse Posn Enable All Planes Delay %end %external %routine Screen Cursor(%integer %name Status1, %record(PointFM) %name Point) Prstring("Screen cursor called"); newline2 Show Cursor(Status1,Point) write1(Point_X,5); write1(Point_Y,5); newline2 Map to Screen(Point) write1(Point_X,5); write1(Point_Y,5); newline2 %end %external %routine Show Cursor1(%integer %name Status1, %record(PointFM) %name Cursor1) %cycle Show Cursor(Status1,Cursor1) %exit %if Status1 = right %repeat %until In DW(Cursor1) %if %not Status1 = right %then %c Set to Grid Point(Cursor1) %end %external %routine Show Cursor2(%integer %name Status2, %record(PointFM) %name Cursor2) %cycle Show Cursor(Status2,Cursor2) %exit %if Status2 = right %repeat %until In DW(Cursor2) %end %external %routine Show Line Cursor(%integer %name Status, %record(PointFM) ori, %record(PointFM) %name Cursor) %integer Stop %record(PointFM) Last=0, Mouse Posn %routine Line Cursor(%record(PointFM) Old,New) %if New_X # Old_X %or New_Y # Old_Y %start Disable RBG Planes Set Colour(0) Move Abs(Old_X, Old_Y) Line Abs(ori_X,ori_Y) %if In DW(New) %start Set Colour(8) Line Abs(New_X,New_Y) %finish %finish %end %cycle Mouse Posn = Read Mouse Cursor1(Mouse Posn) Line Cursor(Last,Mouse Posn) Last = Mouse Posn Stop = Mouse Buttons & 2_111 Reset Mouse(Stop) %repeat %until L or C or R Pressed(Stop) Status = Stop Cursor = Mouse Posn Delay %end %external %routine Show A Line Cursor(%integer %name Status1, %record(PointFM) ori1, %record(PointFM) %name Cursor1) Prstring("Show line cursor1 called") newline2 %cycle Show Line Cursor(Status1,ori1,Cursor1) %exit %if Status1 = right %repeat %until In DW(Cursor1) Set Colour(0) Move Abs(ori1_X,ori1_Y) Line Abs(Cursor1_X,Cursor1_Y) %if Status1 = centre %then Remove Hairline(Cursor1) %if %not Status1 = right %then %c Set to Grid Point(Cursor1) %end %external %routine Show Box Cursor(%integer %name Buttons, %record(PointFM) ori, %record(PointFM) %name Point) %own %record(PointFM) Mouse Posn, Old Posn=0 %integer Stop ! %routine Box Cursor(%record(PointFM) OldC,NewC) ! %if OldC_X # NewC_X %or OldC_Y # NewC_Y %start ! Disable RBG Planes ! %if NewC_Y >= ori_Y %and NewC_Y < DWYT %start ! %if OldC_Y > NewC_Y %start ! Set Colour(0) ! Move Abs(ori_X,OldC_Y) ! Line Abs(ori_X,NewC_Y) ! %finish %else %start ! %if OldC_Y <= ori_Y %or OldC_X <= ori_X %start ! Move Abs(ori_X,ori_Y) ! %finish %else %start ! Move Abs(ori_X,OldC_Y) ! %finish ! Set Colour(8) ! Line Abs(ori_X,NewC_Y) ! %finish ! %finish ! %if NewC_X >= ori_X %and NewC_X < DWXR %start ! %if OldC_X > NewC_X %start ! Set Colour(0) ! Move Abs(OldC_X,ori_Y) ! Line Abs(NewC_X,ori_Y) ! %finish %else %start ! %if OldC_X <= ori_X %or OldC_Y <= ori_Y %start ! Move Abs(ori_X,ori_Y) ! %finish %else %start ! Move Abs(OldC_X,ori_Y) ! %finish ! Set Colour(8) ! Line Abs(NewC_X,ori_Y) ! %finish ! %finish ! %finish ! %end %routine Add Box Lines %if Old Posn_X # Mouse Posn_X %or Old Posn_Y # Mouse Posn_Y %start Set Colour(0) Move Abs(ori_X,Old Posn_Y) Line Abs(ori_X,ori_Y) Line Abs(Old Posn_X,ori_Y) Set Colour(8) Move Abs(ori_X,Mouse Posn_Y) Line Abs(ori_X,ori_Y) Line Abs(Mouse Posn_X,ori_Y) %finish %end %cycle Mouse Posn = Read Mouse Cursor1(Mouse Posn) Add Box Lines Old Posn = Mouse Posn Stop = Mouse Buttons & 2_111 Reset Mouse(Stop) %repeat %until L or C or R Pressed(Stop) Buttons = Stop write1(Buttons,5); newline2 Point = Mouse Posn Delay %end %external %routine Show A Box Cursor(%integer %name Status1, %record(PointFM) %name ori, %record(PointFM) %name Cursor1) %cycle Show Box Cursor(Status1,ori,Cursor1) write1(Status1,5); newline2 %exit %if Status1 = right %repeat %until In DW(Cursor1) Clear Cursor %if %not Status1 = right %start Set to Grid Point(Cursor1) %if ori_X > Cursor1_X %then %c Swop(ori_X,Cursor1_X) %if ori_Y > Cursor1_Y %then %c Swop(ori_Y,Cursor1_Y) %finish %end %external %routine Show B Box Cursor(%integer %name Ht,L,Status, %record(PointFM) %name Cursor) %record(PointFM) Virt Posn,Mouse Posn,Corner %integer Stop %routine Box Cursor1(%record(PointFM) Point,TR) %own %record(PointFM) Last = 0, Last TR =0 %routine Clear Box Lines Set Colour(0) Move Abs(Last TR_X,Last_Y) Line Abs(Last TR_X,Last TR_Y) Line Abs(Last_X,Last TR_Y) %end %routine Add Box Lines Disable RBG Planes %if TR_X >= DWXL %and TR_X <= DWXR %start %if TR_Y <= DWYT %and TR_Y >= DWYB %start %if In DW(Point) %start Set Colour(8) Move Abs(TR_X,Point_Y) Line Abs(TR_X,TR_Y) Line Abs(Point_X,TR_Y) %finish %finish %finish %if Last TR_X # TR_X %or Last TR_Y # TR_Y %start Clear Box Lines %finish %end Cursor1(Point) Add Box Lines Last TR = TR Last = Point %end Disable RBG Planes %cycle Mouse Posn = Read Mouse Corner_X = Mouse Posn_X + L Corner_Y = Mouse Posn_Y + Ht Box Cursor1(Mouse Posn,Corner) Stop = Mouse Buttons & 2_111 Reset Mouse(Stop) %repeat %until L or C or R Pressed(Stop) Delay Status = Stop Cursor = Mouse Posn %end %external %routine Show C Box Cursor(%integer %name Ht,L,Status1, %record(PointFM) %name Cursor1) %record(PointFM) TR %cycle Show B Box Cursor(Ht,L,Status1,Cursor1) write1(Status1,5); newline2 %exit %if Status1 = right TR_X = Cursor1_X + L; TR_Y = Cursor1_Y + Ht %repeat %until In DW(Cursor1) %and In DW(TR) %if %not Status1 = right %then %c Set to Grid Point(Cursor1) %end %external %routine Show Circle Cursor(%integer %name Status,radius, %record(PointFM) ori, %record(PointFM) %name Cursor) %own %record(PointFM) Mouse Posn, Old Posn=0, Screen ori,C Point %integer Stop, rad, Y, X, Max radius %integer %function Max Poss Radius(%record(PointFM) Centre) %result = Min(Min(DWYT - Centre_Y,Centre_Y - DWYB), Min(DWXR - Centre_X,Centre_X - DWXL)) %end %routine Circle Cursor(%record(PointFM) C Point) %own %integer Old Radius =1 %integer S radius %if Mouse Posn_X # Old Posn_X %or Mouse Posn_Y # Old Posn_Y %start Disable RBG Planes Map to Screen(C Point) S radius = C Point_X - Screen ori_X %if S radius = 0 %then S radius = 1 Set Colour(0) Do Round(Screen ori_X,Screen ori_Y,Old Radius) Set Colour(8) Do Round(Screen ori_X,Screen ori_Y,S radius) Old radius = S radius %finish %end Screen ori = ori Map to Screen(Screen ori) %cycle Mouse Posn = Read Mouse Cursor1(Mouse Posn) Max Radius = Max Poss Radius(ori) X = Mouse Posn_X - ori_X Y = Mouse Posn_Y - ori_Y rad = Int(Sqrt((X*X) + (Y*Y))) %if rad = 0 %then rad = 1 %if rad > Max radius %then rad = Max radius C Point_X = ori_X + rad C Point_Y = ori_Y Circle Cursor(C Point) Old Posn = Mouse Posn Stop = Mouse Buttons & 2_111 Reset Mouse(Stop) %repeat %until L or C or R Pressed(Stop) radius = rad Status = Stop Cursor = Mouse Posn Delay %end %external %routine Show A Circle Cursor(%integer %name Status1,radius1, %record(PointFM) ori, %record(PointFM) %name Cursor1) %integer X, Y %cycle Show Circle Cursor(Status1,radius1,ori,Cursor1) %exit %if Status1 = right %repeat %until In DW(Cursor1) Clear Cursor %if %not Status1 = right %start Set to Grid Point(Cursor1) %if Grid On = yes %start X = Cursor1_X - ori_X Y = Cursor1_Y - ori_Y radius1 = Int(Sqrt((X*X) + (Y*Y))) %finish %finish %end %external %routine Show B Circle Cursor(%integer %name Status,radius, %record(PointFM) %name Point) %record(PointFM) Mouse Posn %own %record(PointFM) Last =0 %integer Stop %cycle Mouse Posn = Read Mouse Cursor1(Mouse Posn) %if Last_X # Mouse Posn_X %or Last_Y # Mouse Posn_Y %start Set Colour(0) Disable RBG Planes NCircle(Last_X,Last_Y,radius) %if Mouse Posn_X-radius >= DWXL %start %if Mouse Posn_X+radius <= DWXR %start %if Mouse Posn_Y-radius >= DWYB %start %if Mouse Posn_Y+radius <= DWYT %start Set Colour(8) NCircle(Mouse Posn_X,Mouse Posn_Y,radius) %finish %finish %finish %finish Last = Mouse Posn %finish Stop = Mouse Buttons & 2_111 Reset Mouse(Stop) %repeat %until L or C or R Pressed(Stop) Delay Status = Stop Point = Mouse Posn %end %external %routine Show C Circle Cursor(%integer %name Status1,Radius1, %record(PointFM) %name Cursor1) %predicate In Window %byte result = no %if Cursor1_X - radius1 >= DWXL %and Cursor1_X + radius1 <= DWXR %start %if Cursor1_Y - radius1 >= DWYB %and %c Cursor1_Y + radius1 <= DWYT %then %c result = yes %finish %true %if result = yes %false %end %cycle Show B Circle Cursor(Status1,Radius1,Cursor1) %exit %if Status1 = right %repeat %until In Window %if %not Status1 = right %then %c Set to Grid Point(Cursor1) %end !--------------------------------------------------------------- %external %routine Store Line(%record(PointFM) ori,end,%integer Colour) %record(Line Item) %name Pntr Prstring("Store line called"); newline2 Pntr == New(Pntr) %if %not Horizontal Line(ori_Y,end_Y) %start %if %not T to B(ori_Y,end_Y) %start Swop(ori_Y,end_Y) {Swop if origin below end.} Swop(ori_X,end_X) %finish %finish %else %start %if %not L to R(ori_X,end_X) %start Swop(ori_X,end_X) {Swop if origin to right of end.} %finish %finish Pntr_oriX = ori_X Pntr_oriY = ori_Y Pntr_endX = end_X Pntr_endY = end_Y Pntr_colour = Colour Prstring("Line added to ".Current symbol_name); newline2 Pntr_last == Current Symbol_Lines Pntr_next == Current Symbol_Lines_next %if %not Current Symbol_lines_next == Nil %then %c Current Symbol_lines_next_last == Pntr Current Symbol_lines_next == Pntr %end %external %routine Store Box(%record(PointFM) ori,end,%integer Colour) %record(Box Item) %name Pntr Pntr == New(Pntr) Pntr_oriX = ori_X Pntr_oriY = ori_Y Pntr_endX = end_X Pntr_endY = end_Y Pntr_colour = Colour Pntr_last == Current Symbol_boxes Pntr_next == Current Symbol_boxes_next %if %not Current Symbol_boxes_next == Nil %then %c Current Symbol_boxes_next_last == Pntr Current Symbol_boxes_next == Pntr %end %external %routine Store Text(%record(PointFM) ori,end,%string(80) text, %integer Size,Font,Colour) %record(Text Item) %name Pntr %integer n=0 Prstring("Store text called"); newline2 Pntr == New(Pntr) Pntr_oriX = ori_X Pntr_oriY = ori_Y Pntr_endX = end_X Pntr_endY = end_Y Pntr_Size = Size Pntr_font = Font Pntr_colour = Colour Pntr_text = text Pntr_last == Current Symbol_text Pntr_Next == Current Symbol_text_next %if %not Current Symbol_text_next == Nil %then %c Current Symbol_text_next_last == Pntr Current Symbol_text_next == Pntr %end %external %routine Store Circle(%integer oriX,oriY,radius,colour) %record(Circle Item) %name Pntr Prstring("Store circle called"); newline2 Pntr == New(Pntr) %if Current Symbol_circles_next == Nil %then %c Prstring("CS_C_next == Nil") %else %c Prstring("CS_C_next ## Nil") newline2 Pntr_oriX = oriX Pntr_oriY = oriY Pntr_radius = radius Pntr_colour = colour Pntr_last == Current Symbol_circles Pntr_next == Current Symbol_circles_next %if Pntr_next == Nil %then Prstring("Pntr_next == Nil") %c %else Prstring("Pntr_next ## Nil") newline2 %if Current Symbol_circles_next ## Nil %then %c Current Symbol_circles_next_last == Pntr Current Symbol_circles_next == Pntr %end %external %record(Symbol instance) %map %c Store Symbol Instance(%integer oriX,oriY, endX,endY) %record(Symbol Instance) %name Pntr Pntr == New(Pntr) Pntr_oriX = oriX Pntr_oriY = oriY Pntr_endX = endX Pntr_endY = endY Pntr_last == Current Symbol_symbols Pntr_next == Current Symbol_symbols_next %if Pntr_next ## Nil %then %c Pntr_next_last == Pntr Current Symbol_symbols_next == Pntr %result == Pntr %end %external %record(Symbol) %map Find Insertion Point(%string(10) %name name, %byte List type) %record(Symbol) %name Pntr, Base %string(80) Temp name %option "-nostrass-noass" %if List type = Page table %then Pntr == Base Page Table %else %c Pntr == Base Symbol Table Base == Pntr Retry: %while Pntr_next ## Nil %and name > Pntr_next_name %cycle Pntr == Pntr_next %repeat %if name = Pntr_next_name %start Printsymbol(7) Display Info("Duplicate name """.name.""" Please give alternative.") Read from terminal(Temp name) name = substring(Temp name,1,length(temp name)) Pntr == Base -> Retry %finish %result == Pntr %end !----------------------------------------------------------- %external %routine Redraw Symbol(%integer oriX,oriY,endX,endY) %integer I length, I Ht {Length and height of instance.} %real XSF, YSF {X and Y scaling factors.} %routine Redraw Lines %record(Line Item) %name Pntr %if %not Current Symbol_lines_next == Nil %start Pntr == Current Symbol_lines %cycle Pntr == Pntr_next Set Colour(Pntr_Colour) Move Abs(Int(Pntr_oriX * XSF) + oriX,Int(Pntr_oriY * YSF) + oriY) Line Abs(Int(Pntr_endX * XSF) + oriX,Int(Pntr_endY * YSF) + oriY) %repeat %until Pntr_next == Nil %finish %end %routine Redraw Boxes %record(Box Item) %name Pntr %if %not Current Symbol_boxes_next == Nil %start Pntr == Current Symbol_boxes %cycle Pntr == Pntr_next Set Colour(Pntr_Colour) Box1(Int(Pntr_oriX * XSF) + oriX,Int(Pntr_oriY * YSF) + oriY, Int(Pntr_endX * XSF) + oriX,Int(Pntr_endY * YSF) + oriY) %repeat %until Pntr_next == Nil %finish %end %routine Redraw Text %real SF %integer Offset, Char Size %record(Text Item) %name Pntr Prstring("Redraw text called"); newline2 %if %not Current Symbol_text_next == Nil %start Pntr == Current Symbol_text %cycle Pntr == Pntr_next Prstring("Character size="); write1(Pntr_size,5);newline2 SF = Min1(XSF,YSF) Char Size = Int(Pntr_size * SF) Offset = Int((5/3) * Pntr_size * 0.365) Set Colour(Pntr_Colour) Set Char Size(Char Size) Set Char font(Pntr_font) Move Abs(Int(Pntr_oriX * XSF) + oriX, Int((Pntr_oriY + Offset)* YSF) + oriY) Text(Pntr_text) %repeat %until Pntr_next == Nil Set Char font(0) Set Char Size(Curr Char Size) %finish %end %routine Redraw Circles %record(Circle Item) %name Pntr %if %not Current Symbol_Circles_next == Nil %start Pntr == Current Symbol_Circles %cycle Pntr == Pntr_next Set Colour(Pntr_Colour) Move Abs(Int(Pntr_oriX * XSF) + oriX, Int(Pntr_oriY * YSF) + oriY) Circle(Int(Pntr_radius * Min1(XSF,YSF))) %repeat %until Pntr_next == Nil %finish %end %routine Redraw Symbol Instances %record(Symbol Instance) %name Pntr %record(Symbol) %name Last CS %if %not Current Symbol_symbols_next == Nil %start Prstring(Current Symbol_name." contains symbols") newline2 Last CS == Current Symbol Pntr == Current Symbol_symbols %cycle Pntr == Pntr_next Prstring("Instance dimensions."); newline2 write1(Pntr_oriX,5); write1(Pntr_oriY,5) write1(Pntr_endX,5); write1(Pntr_endY,5) newline2 Current Symbol == Pntr_table entry Redraw Symbol(Int(Pntr_oriX * XSF) + oriX, Int(Pntr_oriY * YSF) + oriY, Int(Pntr_endX * XSF) + oriX, Int(Pntr_endY * YSF) + oriY) %repeat %until Pntr_next == Nil Current Symbol == Last CS %finish %end Enable All Planes Clear Info; Clear Mouse Info Prstring("Redrawing Symbol ".Current Symbol_name) newline2 Prstring("Length, Ht & type:"); write1(Current symbol_length,5) write1(Current symbol_Ht,5); newline2 write1(Current symbol_type,5); newline2 I length = endX - oriX I Ht = endY - oriY %if I length > 0 %then %c XSF = I length / Current Symbol_length %c %else XSF = 1 %if I Ht > 0 %then %c YSF = I Ht / Current Symbol_Ht %c %else YSF = 1 Redraw lines Redraw Boxes Redraw Circles Redraw Text Redraw Symbol Instances Set Colour(Curr Colour) %end %external %routine Redraw Grid(%integer AXL,AYB) %if AXL <= DWXL + Scale Line Length %then %c Draw Y Scale(1,Grid Interval) %if AYB <= DWYB + Scale Line Length %then %c Draw X Scale(1,Grid Interval) %end %external %routine Redraw Area(%integer AXL,AYB,AXR,AYT, IXL,IYB,IXR,IYT) !A__ are the boundary values for the page area to be redrawn. !I__ are the boundary values of the symbol instance. %integer I length, I Ht {Length and height of instance.} %real XSF, YSF {X and Y scaling factors.} %record(Symbol) %name Last CS %routine Redraw Lines in Area %label Dont Draw %integer oriX,oriY,endX,endY %record(Line Item) %name Pntr %if %not Current Symbol_lines_next == Nil %start Pntr == Current Symbol_lines %cycle Pntr == Pntr_next oriX = Int(Pntr_oriX * XSF) + IXL oriY = Int(Pntr_oriY * YSF) + IYB endX = Int(Pntr_endX * XSF) + IXL endY = Int(Pntr_endY * YSF) + IYB %if oriY > AYT %and endY > AYT %then -> Dont Draw %if oriY < AYB %and endY < AYB %then -> Dont Draw %if oriX < AXL %and endX < AXL %then -> Dont Draw %if oriX > AXR %and endX > AXR %then -> Dont Draw Set Colour(Pntr_Colour) Move Abs(oriX,oriY) Line Abs(endX,endY) Dont Draw: %repeat %until Pntr_next == Nil %finish %end %routine Redraw Boxes in Area %label Dont Draw %integer oriX,oriY,endX,endY %record(Box Item) %name Pntr %if %not Current Symbol_boxes_next == Nil %start Pntr == Current Symbol_boxes %cycle Pntr == Pntr_next oriX = Int(Pntr_oriX * XSF) + IXL oriY = Int(Pntr_oriY * YSF) + IYB endX = Int(Pntr_endX * XSF) + IXL endY = Int(Pntr_endY * YSF) + IYB %if oriY > AYT %and endY > AYT %then -> Dont Draw %if oriY < AYB %and endY < AYB %then -> Dont Draw %if oriX < AXL %and endX < AXL %then -> Dont Draw %if oriX > AXR %and endX > AXR %then -> Dont Draw Set Colour(Pntr_Colour) Box1(oriX,oriY,endX,endY) Dont Draw: %repeat %until Pntr_next == Nil %finish %end %routine Redraw Text in Area %label Dont Draw %real SF %integer oriX,oriY,endX,endY, Top, Rt End, Char Size, Offset %record(Text Item) %name Pntr %if %not Current Symbol_text_next == Nil %start Pntr == Current Symbol_text %cycle Pntr == Pntr_next oriX = Int(Pntr_oriX * XSF) + IXL oriY = Int(Pntr_oriY * YSF) + IYB endX = Int(Pntr_endX * XSF) + IXL endY = Int(Pntr_endY * YSF) + IYB %if oriY > AYT %and endY > AYT %then -> Dont Draw %if oriY < AYB %and endY < AYB %then -> Dont Draw %if oriX < AXL %and endX < AXL %then -> Dont Draw %if oriX > AXR %and endX > AXR %then -> Dont Draw Set Colour(Pntr_Colour) Prstring("Character size="); write1(Pntr_size,5);newline2 SF = Min1(XSF,YSF) Char Size = Int(Pntr_size * SF) Offset = Int((5/3) * Pntr_size * 0.365) Set Colour(Pntr_Colour) Set Char Size(Char Size) Set Char font(Pntr_font) Move Abs(oriX,Int((Pntr_oriY+ Offset) * YSF) + IYB) Text(Pntr_text) Dont Draw: %repeat %until Pntr_next == Nil Set Char font(Curr Char Font) Set Char Size(Curr Char Size) Set Char Rot (Curr Char Rot) %finish %end %routine Redraw Circles in Area %label Dont Draw %integer oriX,oriY, radius %record(Circle Item) %name Pntr %if %not Current Symbol_Circles_next == Nil %start Pntr == Current Symbol_Circles %cycle Pntr == Pntr_next oriX = Int(Pntr_oriX * XSF) + IXL oriY =Int(Pntr_oriY * YSF) + IYB radius = Int(Pntr_radius * Min1(XSF,YSF)) %if oriY - radius > AYT %then -> Dont Draw %if oriY + radius < AYB %then -> Dont Draw %if oriX + radius < AXL %then -> Dont Draw %if oriX - radius > AXR %then -> Dont Draw Set Colour(Pntr_Colour) Move Abs(oriX,oriY) Circle(radius) Dont Draw: %repeat %until Pntr_next == Nil %finish %end %routine Redraw Symbols in Area %label Dont Draw %integer oriX,oriY,endX,endY %record(Symbol Instance) %name Pntr %record(Symbol) %name Last CS %if %not Current Symbol_symbols_next == Nil %start Last CS == Current Symbol Pntr == Current Symbol_symbols %cycle Pntr == Pntr_next oriX = Int(Pntr_oriX * XSF) + IXL oriY = Int(Pntr_oriY * YSF) + IYB endX = Int(Pntr_endX * XSF) + IXL endY = Int(Pntr_endY * YSF) + IYB %if oriY > AYT %and endY > AYT %then -> Dont Draw %if oriY < AYB %and endY < AYB %then -> Dont Draw %if oriX < AXL %and endX < AXL %then -> Dont Draw %if oriX > AXR %and endX > AXR %then -> Dont Draw Current Symbol == Pntr_table entry Redraw Area(AXL,AYB,AXR,AYT,oriX,oriY,endX,endY) Dont Draw: %repeat %until Pntr_next == Nil Current Symbol == Last CS %finish %end Enable All Planes Clear Info; Clear Mouse Info Prstring("Redrawing Area of Symbol ".Current Symbol_name) newline2 Prstring("Length, Ht & type:"); write1(Current symbol_length,5) write1(Current symbol_Ht,5); newline2 write1(Current symbol_type,5); newline2 I length = IXR - IXL I Ht = IYT - IYB %if I length > 0 %then %c XSF = I length / Current Symbol_length %c %else XSF = 1 %if I Ht > 0 %then %c YSF = I Ht / Current Symbol_Ht %c %else YSF = 1 Redraw lines in Area Redraw Boxes in Area Redraw Circles in Area Redraw Text in Area Redraw Symbols in Area Set Colour(Curr Colour) %end %external %routine Redraw Box Area(%integer XL,YB,XR,YT) Redraw Area(XL-1,YT-1,XR+1,YT+1,0,0, Current Symbol_length,Current Symbol_Ht) Redraw Area(XL-1,YB-1,XR+1,YB+1,0,0, Current Symbol_length,Current Symbol_Ht) Redraw Area(XL-1,YB+1,XL+1,YT+1,0,0, Current Symbol_length,Current Symbol_Ht) Redraw Area(XR-1,YB+1,XR+1,YT-1,0,0, Current Symbol_length,Current Symbol_Ht) Redraw Grid(XL,YB) %end !-------------------------------------------------------------- %external %record(Symbol) %map Choose Sym by name(%integer Table type) %label Abort %byte n=0, Last Place stopped=0, Item %record(Symbol) %name Pntr, Base %record(PointFM) Cursor %integer Status n=0 last place stopped=0 %if Table type = Page Table %then Base == Base Page Table %else %c Base == Base Symbol Table Pntr == Nil %if Base_next == Nil %start Error Message("No symbols in table.") %else Pntr == Base %cycle Clear Menu Last Place stopped = Last Place Stopped + n n = 0 Set Colour(yellow) %cycle Pntr == Pntr_next {Display names of symbols} n = n + 1 Placeword(Pntr_name,20,Menu(n)) %repeat %until Pntr_next == Nil %or n = 11 Set Colour(Lime) Placeword("NEXT",20,Menu(n+1)) Retry: %cycle Display Info("Please select item.") Mouse Info("CHOOSE","CHOOSE","ABORT") Screen Cursor(Status,Cursor) {Show cursor to allow} %if Status = right %start {selection of name.} Pntr == Nil -> Abort %finish Item = Menu Item(Cursor) {Repeat until name selected.} %repeat %until Item > 0 %and Item <= n +1 %repeat %until Item # n +1 %or Pntr_next == Nil %if Item = n+1 %start {Repeat if "NEXT"} Clear Cursor {selected and more items} Error Message("No more items.") {to display.} -> Retry %finish Pntr == Base %for n = 1,1,(Last Place Stopped + Item) %cycle Pntr == Pntr_next {Find corresponding} %repeat {record in list.} Abort: Set Colour(Curr Colour) %finish %result == Pntr %end %external %record(Symbol Instance) %map %c Choose Symbol Instance(%integer oriX,oriY, %record(PointFM) Point) %byte Found = no %integer Status, Correct = no, Part = no, AbsXL,AbsXR,AbsYB,AbsYT %record(Symbol Instance) %name Pntr %record(Symbol) %name Last CS %predicate Symbol not in Window(%integer XL,YB,XR,YT) Prstring("Symbol not in window called"); newline2 %if XL < DWXL %and XR > DWXR %start %if YB < DWYB %and YT > DWYT %start %true %finish %finish %false %end Prstring("Choose Symbol Instance called"); newline2 %if %not Current Symbol_symbols_next == Nil %start Prstring("CS_SYM_NEXT # Nil"); newline2 Pntr == Current Symbol_Symbols %cycle Prstring("Select Symbol called"); newline2 Found = no %cycle Prstring("Repeat-until loop entered"); newline2 Pntr == Pntr_next AbsXL = Pntr_oriX + oriX; AbsYB = Pntr_oriY + oriY AbsXR = Pntr_endX + oriX; AbsYT = Pntr_endY + oriY %if %not Symbol not in Window(AbsXL,AbsYB,AbsXR,AbsYT) %start Prstring("Symbol in window"); newline2 %if Point_X >= AbsXL %and Point_X <= AbsXR %start %if Point_Y >= AbsYB %and Point_Y <= AbsYT %then %c Found = yes %finish %finish Prstring("Found= "); write1(Found,3); newline2 %repeat %until Pntr_next == Nil %or Found = yes ! write1(Pntr_oriX,4); write1(Pntr_oriY,4); newline2 %if Found = yes %start Prstring("Found = yes"); newline2 Disable RBG Planes Clear Cursor Set Colour(8) Box1(AbsXL,AbsYB,AbsXR,AbsYT) Enable All Planes Display Info("Correct ?") Confirm(correct) %if correct = no %start Disable RBG Planes Set Colour(0) Box1(AbsXL,AbsYB,AbsXR,AbsYT) Enable All Planes Found = no %finish %finish %repeat %until Correct = yes %or Pntr_next == Nil %finish Prstring("When setting %result Found = "); write1(found,4); newline2 Clear Cursor %if Correct = yes %then %result == Pntr %else %c %result == Nil %end %external %routine Set Window(%integer XL,YB,XR,YT) DWXL = XL; DWXR = XR DWYB = YB; DWYT = YT Window(XL,XR,YB,YT) Scale Line Length = Int(0.02 * Min((DWXR - DWXL),(DWYT - DWYB))) %end %external %routine Set Virtual Screen VSXL = 0; VSYB = 0 VSXR = 687; VSYT = 547 Map to Virtual Coords(VSXL,VSYB) Map to Virtual Coords(VSXR,VSYT) %end %external %routine Set Max Viewport(%integer XL,YB,XR,YT) %constant %real DA HL ratio = 0.84095 {DA Ht / DA length.} %record(PointFM) OldBL=0, OldTR=0 %real Window HL ratio ,SF %integer Ht, L, Scaled Ht OldBL_X = VPXL; OldBL_Y = VPYB; OldTR_X = VPXR; OldTR_Y = VPYT Ht = YT - YB; L = XR - XL %if Ht = 0 %then Ht = 1 %if L = 0 %then L = 1 Window HL ratio = Ht / L %if Window HL ratio >= DA HL ratio %then SF = Ht / 460 %else %c SF = L / 546 VPXL = 140 VPXR = 140 + Int(L / SF) Scaled Ht = Int(Ht / SF) VPYB = 1 + ((460 - Scaled Ht) // 2) VPYT = Min(VPYB + Scaled Ht,460) Scaling = Max(1,Int(1/SF)) Prstring("Scaling ="); write1(Scaling,1); newline2 %if Scaling > 1 %start MouseX = 0; MouseY = 0 %finish Viewport(VPXL,VPXR,VPYB,VPYT) Set Virtual Screen Enable All Planes Set Colour(0) Box2(OldBL_X-1,OldBL_Y-1,OldTR_X+1,OldTR_Y+1) Set Colour(Red) Box2(139,0,687,461) Set Colour(Black) Box2(VPXL-1,VPYB-1,VPXR+1,VPYT+1) %end %external %routine Set Lifesize Viewport(%integer XL,YB,XR,YT) %record(PointFM) OldBL, OldTR %integer X disp,Ydisp,L,Ht OldBL_X = VPXL; OldBL_Y = VPYB OldTR_X = VPXR; OldTR_Y = VPYT L = XR - XL; Ht = YT - YB L = Int(L*0.68); Ht=Int(Ht*0.68) %if L = 546 %then X disp = 0 %else %c X disp = Int((546 - L) / 2) %if Ht = 460 %then Y disp = 0 %else %c Y disp = Int((460 - Ht) / 2) VPXL = 140 + X disp VPYB = Y disp VPXR = VPXL + L VPYT = VPYB + Ht Viewport(VPXL,VPXR,VPYB,VPYT) Set Virtual Screen Set Colour(Blank) Box2(OldBL_X-1,OldBL_Y-1,OldTR_X+1,OldTR_Y+1) Set Colour(red) Box2(139,0,687,461) Set Colour(Black) Box2(VPXL-1,VPYB-1,VPXR+1,VPYT+1) Redraw Area(DWXL,DWYB,DWXR,DWYT,0,0, Current Symbol_length,Current Symbol_Ht) Draw Grid %end !----------------------------------------------------------------- %external %routine PDF One Colour(%integer Colour,oriX,oriY,endX,endY) %integer I Length, I Ht %real XSF, YSF %routine PDF Lines %record(Line Item) %name Pntr %if %not Current Symbol_lines_next == Nil %start Pntr == Current Symbol_lines %cycle Pntr == Pntr_next %if Pntr_colour = Colour %start Move Abs(Int(Pntr_oriX * XSF) + oriX, Int(Pntr_oriY * YSF) + oriY) Line Abs(Int(Pntr_endX * XSF) + oriX, Int(Pntr_endY * YSF) + oriY) %finish %repeat %until Pntr_next == Nil %finish %end %routine PDF Boxes %record(Box Item) %name Pntr %if %not Current Symbol_boxes_next == Nil %start Pntr == Current Symbol_boxes %cycle Pntr == Pntr_next %if Pntr_colour = Colour %start Box1(Int(Pntr_oriX * XSF) + oriX, Int(Pntr_oriY * YSF) + oriY, Int(Pntr_endX * XSF) + oriX, Int(Pntr_endY * YSF) + oriY) %finish %repeat %until Pntr_next == Nil %finish %end %routine PDF Text %integer Char Size, Offset %record(Text Item) %name Pntr %if %not Current Symbol_text_next == Nil %start Pntr == Current Symbol_text %cycle Pntr == Pntr_next %if Pntr_colour = Colour %start Char Size = Int(Pntr_size * Min1(XSF,YSF)) Offset = Int(((5/3) * Pntr_Size) * 0.365) Move Abs(Int(Pntr_oriX * XSF) + oriX, Int((Pntr_oriY + Offset) * YSF) + oriY) Set Char Size(Char Size) Set Char font(Pntr_font) Text(Pntr_text) %finish %repeat %until Pntr_next == Nil Set Char Size(Curr Char Size) Set Char font(Curr Char Font) Set Char Rot (Curr Char Rot) %finish %end %routine PDF Circles %integer Char Size, Offset %record(Circle Item) %name Pntr %if %not Current Symbol_Circles_next == Nil %start Pntr == Current Symbol_circles %cycle Pntr == Pntr_next %if Pntr_colour = Colour %start Move Abs(Int(Pntr_oriX * XSF) + oriX, Int(Pntr_oriY * YSF) + oriY) Circle(Int(Pntr_radius * Min1(XSF,YSF))) %finish %repeat %until Pntr_next == Nil %finish %end %routine PDF Symbols %record(Symbol) %name Last CS %record(Symbol instance) %name Pntr %if %not Current Symbol_symbols_next == Nil %start Pntr == Current Symbol_symbols Last CS == Current Symbol %cycle Pntr == Pntr_next Current Symbol == Pntr_table entry PDF One Colour(Colour,Int(Pntr_oriX * XSF) + oriX, Int(Pntr_oriY * YSF) + oriY, Int(Pntr_endX * XSF) + oriX, Int(Pntr_endY * YSF) + oriY) %repeat %until Pntr_next == Nil Current Symbol == Last CS %finish %end I length = endX - oriX I Ht = endY - oriY %if I length = 0 %then XSF = 1 %else %c XSF = I length / Current Symbol_length %if I Ht = 0 %then YSF = 1 %else %c YSF = I Ht / Current Symbol_Ht Set Colour(Colour) PDF lines PDF Boxes PDF Text PDF Circles PDF Symbols %end %external %routine PDF Item in(%integer Table type) %integer XL, XR, YB, YT, Colour = 1, VXL,VXR,VYB,VYT %record(Symbol) %name Last CS, Pntr %string(255) filename %label Retry %on %event 3,4,9 %start Select Output(0) write1(event_event,5);write1(event_sub,5);newline2 Error Message("ERROR: File cannot be opened.") -> Retry %finish Clear Cursor Pntr == Choose Sym by name(Table type) Display Main menu %return %if Pntr == Nil Retry: Display Info("Enter file name.") Move To(1,9) Clear Line read(filename) Move To(V200X,V200Y) To Upper (filename) %return %if filename = "ABORT" Last CS == Current Symbol Current Symbol == Pntr XL = DWXL; XR = DWXR YB = DWYB; YT = DWYT VXL = VPXL; VXR = VPXR VYB = VPYB; VYT = VPYT Enable All Planes Set Chord Step(1) Clear Mouse Info Display Info("Writing to ".filename.".PDF") Select Output(1) Open Output(1,filename.".PDF") Store On(1) View Off Window(0,Current Symbol_length,0,Current Symbol_Ht) Viewport(0,Current Symbol_length,0,Current Symbol_Ht) Set Char Quality(Software Text) %cycle PDF One Colour(Colour,0,0,Current Symbol_Length,Current Symbol_Ht) Colour = Colour + 1 %repeat %until Colour = 8 View On(0) Store Off Close Output Select Output(0) Set Chord Step(5) Current Symbol == Last CS Set Window(XL,YB,XR,YT) ! Set Max Viewport(XL,YB,XR,YT) Viewport(VXL,VXR,VYB,VYT) %end !--------------------------------------------------------------------- %external %routine Define Area(%record(PointFM) %name BL Corner,TR Corner, %integer %name Status) %integer TR fixed = no %record(PointFM) Cursor,Marker %cycle Display Info("Position one corner") Mouse Info("FIX","FIX","ABORT") Show Cursor1(Status,BL Corner) %return %if Status = right Display Info("Fix Area.") Show A Box Cursor(Status,BL Corner,Cursor) Clear Cursor %return %if Status = right Set Colour(8) {Show Area.} Box1(BL Corner_X,BL Corner_Y,Cursor_X,Cursor_Y) Enable All Planes Display Info("OK ?") Confirm(TR fixed) TR Corner = Cursor Disable RBG Planes {Whether OK or not clear} Set Colour(0) {Cursor plane.} Box1(BL Corner_X,BL Corner_Y,TR Corner_X,TR Corner_Y) Enable All Planes Clear Info Clear Mouse Info %repeat %until TR fixed = Yes %end !--------------------------------------------------------------------- %external %record(Symbol) %map Create Symbol %integer Status %record(Symbol) %name ST Pntr %record(PointFM) BL,TR %routine Transfer Lines in Area %record(Line Item) %name Pntr, Next item Prstring("Transfer lines called"); newline2 %if %not Current Symbol_lines_next == Nil %start Pntr == Current Symbol_lines Next item == Pntr_next %cycle Pntr == Next Item Next Item == Pntr_next %if Pntr_oriY <= TR_Y %and Pntr_endY <= TR_Y %start %if Pntr_oriY >= BL_Y %and Pntr_endY >= BL_Y %start %if Pntr_oriX >= BL_X %and Pntr_endX >= BL_X %start %if Pntr_oriX <= TR_X %and Pntr_endX <= TR_X %start Pntr_last_next == Pntr_next %if Pntr_next ## Nil %then %c Pntr_next_last == Pntr_last Pntr_last == ST Pntr_lines Pntr_next == ST Pntr_lines_next %if ST Pntr_lines_next ## Nil %then %c ST Pntr_lines_next_last == Pntr ST Pntr_lines_next == Pntr %finish %finish %finish %finish %repeat %until Next item == Nil %finish %end %routine Transfer Boxes in Area %record(Box Item) %name Pntr, Next item Prstring("Transfer Boxes called"); newline2 %if %not Current Symbol_boxes_next == Nil %start Pntr == Current Symbol_boxes Next Item == Pntr_next %cycle Pntr == Next Item Next Item == Pntr_next %if Pntr_oriY <= TR_Y %and Pntr_endY <= TR_Y %start %if Pntr_oriY >= BL_Y %and Pntr_endY >= BL_Y %start %if Pntr_oriX >= BL_X %and Pntr_endX >= BL_X %start %if Pntr_oriX <= TR_X %and Pntr_endX <= TR_X %start Pntr_last_next == Pntr_next %if Pntr_next ## Nil %then %c Pntr_next_last == Pntr_last Pntr_last == ST Pntr_boxes Pntr_next == ST Pntr_boxes_next %if Pntr_next ## Nil %then %c Pntr_next_last == Pntr ST Pntr_boxes_next == Pntr %finish %finish %finish %finish %repeat %until Next Item == Nil %finish %end %routine Transfer Text in Area %integer Top, Rt End %record(Text Item) %name Pntr, Next Item %if %not Current Symbol_text_next == Nil %start Pntr == Current Symbol_text Next Item == Pntr_next %cycle Pntr == Next Item Next Item == Pntr_next %if Pntr_oriY <= TR_Y %and Pntr_endY <= TR_Y %start %if Pntr_oriY >= BL_Y %and Pntr_endY >= BL_Y %start %if Pntr_oriX >= BL_X %and Pntr_endX >= BL_X %start %if Pntr_oriX <= TR_X %and Pntr_endX <= TR_X %start Pntr_last_next == Pntr_next %if Pntr_next ## Nil %then %c Pntr_next_last == Pntr_last Pntr_last == ST Pntr_text Pntr_next == ST Pntr_text_next %if ST Pntr_text_next ## Nil %then %c ST Pntr_text_next_last == Pntr ST Pntr_text_next == Pntr %finish %finish %finish %finish %repeat %until Next Item == Nil %finish %end %routine Transfer Circles in Area %record(Circle Item) %name Pntr,Next Item %if %not Current Symbol_Circles_next == Nil %start Pntr == Current Symbol_Circles Next Item == Pntr_next %cycle Pntr == Next Item Next Item == Pntr_next %if Pntr_oriY + Pntr_radius <= TR_Y %start %if Pntr_oriY - Pntr_radius >= BL_Y %start %if Pntr_oriX - Pntr_radius >= BL_X %start %if Pntr_oriX + Pntr_radius <= TR_X %start Pntr_last_next == Pntr_next %if Pntr_next ## Nil %then %c Pntr_next_last == Pntr_last Pntr_last == ST Pntr_circles Pntr_next == ST Pntr_circles_next %if ST Pntr_circles_next ## Nil %then %c ST Pntr_circles_next_last == Pntr ST Pntr_circles_next == Pntr %finish %finish %finish %finish %repeat %until Next Item == Nil %finish %end %routine Transfer Symbols in Area %record(Symbol Instance) %name Pntr, Next Item %if %not Current Symbol_symbols_next == Nil %start Pntr == Current Symbol_symbols Next Item == Pntr_next %cycle Pntr == Next Item Next Item == Pntr_next %if Pntr_oriY <= TR_Y %and Pntr_endY <= TR_Y %start %if Pntr_oriY >= BL_Y %and Pntr_endY >= BL_Y %start %if Pntr_oriX >= BL_X %and Pntr_endX >= BL_X %start %if Pntr_oriX <= TR_X %and Pntr_endX <= TR_X %start Pntr_last_next == Pntr_next %if Pntr_next ## Nil %then %c Pntr_next_last == Pntr_last Pntr_last == ST Pntr_symbols Pntr_next == ST Pntr_symbols_next %if ST Pntr_symbols_next ## Nil %then %c ST Pntr_symbols_next_last == Pntr ST Pntr_symbols_next == Pntr %finish %finish %finish %finish %repeat %until Next Item == Nil %finish %end Prstring("Create symbol called"); newline2 %if Current Symbol_lines_next ## Nil %or %c Current Symbol_boxes_next ## Nil %or %c Current Symbol_circles_next ## Nil %or %c Current Symbol_text_next ## Nil %or %c Current symbol_symbols_next ## Nil %start Enable All Planes Clear Info; Clear Mouse Info Display Main Menu ST Pntr == New(ST Pntr) ST Pntr = 0 Define Area(BL,TR,Status) %if Status = right %start %result == Nil %finish Transfer lines in Area Transfer Boxes in Area Transfer Text in Area Transfer Circles in Area Transfer Symbols in Area %finish %result == ST Pntr %end %external %routine Find Limits(%integer %name oriX,oriY,endX,endY) %integer minX = 2000,minY = 2000,maxX = 0,maxY = 0 %routine For Lines %record(Line Item) %name Pntr %integer CminX,CminY,CmaxX,CmaxY Prstring("For lines called"); newline2 %if %not Current Symbol_lines_next == Nil %start Pntr == Current Symbol_lines %cycle Pntr == Pntr_next CminX = Min(Pntr_oriX,Pntr_endX) CminY = Min(Pntr_oriY,Pntr_endY) CmaxX = Max(Pntr_oriX,Pntr_endX) CmaxY = Max(Pntr_oriY,Pntr_endY) %if CminX < MinX %then MinX = CminX %if CminY < MinY %then MinY = CminY %if CmaxX > MaxX %then MaxX = CmaxX %if CmaxY > MaxY %then MaxY = CmaxY %repeat %until Pntr_next == Nil %finish %end %routine For Boxes %record(Box Item) %name Pntr Prstring("For Boxes called"); newline2 %if %not Current Symbol_boxes_next == Nil %start Pntr == Current Symbol_boxes %cycle Pntr == Pntr_next %if Pntr_oriX < MinX %then MinX = Pntr_oriX %if Pntr_oriY < MinY %then MinY = Pntr_oriY %if Pntr_endY > MaxY %then MaxY = Pntr_endY %if Pntr_endX > MaxX %then MaxX = Pntr_endX %repeat %until Pntr_next == Nil %finish %end %routine For Text %record(Text Item) %name Pntr Prstring("For text called"); newline2 %if %not Current Symbol_text_next == Nil %start Pntr == Current Symbol_text %cycle Pntr == Pntr_next %if Pntr_oriX < MinX %then MinX = Pntr_oriX %if Pntr_oriY < MinY %then MinY = Pntr_oriY %if Pntr_endX > MaxX %then MaxX = Pntr_endX %if Pntr_endY > MaxY %then MaxY = Pntr_endY %repeat %until Pntr_next == Nil %finish %end %routine For Circles %integer XL, YB, XR, YT %record(Circle Item) %name Pntr Prstring("For Circles called"); newline2 %if %not Current Symbol_Circles_next == Nil %start Pntr == Current Symbol_Circles %cycle Pntr == Pntr_next XL = Pntr_oriX - Pntr_radius YB = Pntr_oriY - Pntr_radius XR = Pntr_oriX + Pntr_radius YT = Pntr_oriY + Pntr_radius %if XL < MinX %then MinX = XL %if YB < MinY %then MinY = YB %if XR > MaxX %then MaxX = XR %if YT > MaxY %then MaxY = YT %repeat %until Pntr_next == Nil %finish %end %routine For Symbols %record(Symbol Instance) %name Pntr Prstring("For symbols called"); newline2 %if %not Current Symbol_symbols_next == Nil %start Pntr == Current Symbol_symbols %cycle Pntr == Pntr_next %if Pntr_oriX < MinX %then MinX = Pntr_oriX %if Pntr_oriY < MinY %then MinY = Pntr_oriY %if Pntr_endX > MaxX %then MaxX = Pntr_endX %if Pntr_endY > MaxY %then MaxY = Pntr_endY %repeat %until Pntr_next == Nil %finish %end Prstring("Find Limits called"); newline2 For lines; For Boxes; For Text; For Circles; For Symbols oriX = minX; oriY = minY; endX = maxX; endY = maxY %end %external %routine Convert to Rel Coords(%integer oriX,oriY) %routine Convert Lines %record(Line Item) %name Pntr %if %not Current Symbol_lines_next == Nil %start Pntr == Current Symbol_lines %cycle Pntr == Pntr_next Pntr_oriX = Pntr_oriX - oriX Pntr_oriY = Pntr_oriY - oriY Pntr_endX = Pntr_endX - oriX Pntr_endY = Pntr_endY - oriY %repeat %until Pntr_next == Nil %finish %end %routine Convert Boxes %record(Box Item) %name Pntr %if %not Current Symbol_boxes_next == Nil %start Pntr == Current Symbol_boxes %cycle Pntr == Pntr_next Pntr_oriX = Pntr_oriX - oriX Pntr_oriY = Pntr_oriY - oriY Pntr_endX = Pntr_endX - oriX Pntr_endY = Pntr_endY - oriY %repeat %until Pntr_next == Nil %finish %end %routine Convert Text %record(Text Item) %name Pntr Prstring("Convert Text called"); newline2 %if %not Current Symbol_text_next == Nil %start Pntr == Current Symbol_text %cycle Pntr == Pntr_next Pntr_oriX = Pntr_oriX - oriX Pntr_oriY = Pntr_oriY - oriY Pntr_endX = Pntr_endX - oriX Pntr_endY = Pntr_endY - oriY %repeat %until Pntr_next == Nil %finish %end %routine Convert Symbols %record(Symbol Instance) %name Pntr %if %not Current Symbol_symbols_next == Nil %start Pntr == Current Symbol_symbols %cycle Pntr == Pntr_next Pntr_oriX = Pntr_oriX - oriX Pntr_oriY = Pntr_oriY - oriY Pntr_endX = Pntr_endX - oriX Pntr_endY = Pntr_endY - oriY %repeat %until Pntr_next == Nil %finish %end %routine Convert Circles %record(Circle Item) %name Pntr %if %not Current Symbol_Circles_next == Nil %start Pntr == Current Symbol_Circles %cycle Pntr == Pntr_next Pntr_oriX = Pntr_oriX - oriX Pntr_oriY = Pntr_oriY - oriY %repeat %until Pntr_next == Nil %finish %end Prstring("Convert to Rel Coords called"); newline2 Convert lines; Convert Boxes Convert Text; Convert Symbols Convert Circles %end !------------------------------------------------------------- %external %routine Set A4(%integer %name L,Ht) %integer Status %cycle Display Info("Vertical or Horizontal ?") Choose from(Status,"Vertical"," ","Horizontal") %repeat %until Status = left %or Status = right %if Status = left %start L=840; Ht=1190 %finish %else %start L=1190; Ht=840 %finish %end %external %routine Set Slide(%integer %name L,Ht) L=860; Ht=1060 %end %external %routine Set A3(%integer %name L,Ht) L=1680; Ht=1190 %end !------------------------------------------------------------- %external %record(Line Item) %Map Choose Line(%record(PointFM) Point) %label Abort %byte Found =no %integer Status,Correct = no %record(Line Item) %name Pntr %routine Select Line(%record (PointFM) Point,%byte %name Found) %real Tan angle %integer Y Coord,e1X,e1Y,e2X,e2Y, Field Radius %predicate In range(%integer Point Coord,Line Coord) Prstring("In range called");newline2 write1(Point Coord,4); write1(Line Coord,4); newline2 %true %if Point Coord <= Line Coord + Field Radius %and %c Point Coord >= Line Coord - Field Radius %false %end %integer %function Calc Y Coord(%integer PointX,oriX,oriY, endX,endY,L to R) %integer opp1, adj1,opp2, adj2 Prstring("Calc Y Coord called");newline2 opp1 = oriY - endY %if L to R = yes %start adj1 = endX - oriX adj2 = endX - PointX %finish %else %start adj1 = oriX - endX adj2 = PointX - endX %finish Tan angle = opp1 / adj1 opp2 = Int(Tan angle * adj2) %result = opp2 + endY %end Prstring("Select Line called"); newline2 Found = no %while %not Pntr_next == Nil %and Found = no %cycle Pntr == Pntr_next %if Horizontal line(Pntr_oriY,Pntr_endY) %start Prstring("Horizontal line"); newline2 %if Between A and B(Point_X,Pntr_oriX,Pntr_endX) %start Field Radius = 10 Prstring("Pntr_oriY= "); write1(Pntr_oriY,5); newline2 %if Inrange(Point_Y,Pntr_oriY) %then %c Found = yes %finish %finish %else %if Vertical line(Pntr_oriX,Pntr_endX) %start Prstring("Vertical line"); newline2 %if Between A and B(Point_Y,Pntr_endY,Pntr_oriY) %start Field Radius = 10 %if Inrange(Point_X,Pntr_oriX) %then %c Found = Yes %finish %finish %else %start Prstring("Sloping line"); newline2 %if Between A and B(Point_Y,Pntr_endY,Pntr_oriY) %start %if L to R(Pntr_oriX,Pntr_endX) %start %if Between A and B(Point_X,Pntr_oriX,Pntr_endX) %start Y Coord = Calc Y Coord(Point_X,Pntr_oriX,Pntr_oriY, Pntr_endX,Pntr_endY,yes) Field Radius =Max(Int(10 * Tan Angle),10) %if In range(Point_Y,Y Coord) %then %c Found = yes %finish %finish %else %start %if Between A and B(Point_X,Pntr_endX,Pntr_oriX) %start Y Coord = Calc Y Coord(Point_X,Pntr_oriX,Pntr_oriY, Pntr_endX,Pntr_endY,no) Field Radius =Max(Int(10 * Tan Angle),10) %if Inrange(Point_Y,Y Coord) %then %c Found = yes %finish %finish %finish %finish %repeat Set Colour(Curr Colour) %end Pntr == Current Symbol_lines %cycle Select Line(Point,Found) %if Found = yes %start Disable RBG Planes Clear Cursor Set Colour(8) Move Abs(Pntr_oriX,Pntr_oriY) Line Abs(Pntr_endX,Pntr_endY) Enable All Planes Display Info("Correct ?") Confirm(correct) %if %not correct = yes %start Disable RBG Planes Set Colour(0) Move Abs(Pntr_endX,Pntr_endY) Line Abs(Pntr_oriX,Pntr_oriY) Enable All Planes Found = no Status = left %finish %finish %repeat %until Correct = yes %or Pntr_next == Nil Abort: Prstring("At end of Select line found ="); write1(Found,3);newline2 %if Found = no %then %result == Nil %else %c %result == Pntr %end %external %record(Box Item) %map Choose Box(%record(PointFM) Point) %byte Found =no %integer Status,Correct = no %record(Box Item) %name Pntr %routine Select Box(%record (PointFM) Point,%byte %name Found) %predicate Box not in Window(%integer XL,YB,XR,YT) %if XL < DWXL %and XR > DWXR %start %if YB < DWYB %and YT > DWYT %start %true %finish %finish %false %end Prstring("Select Box called"); newline2 Found = no %while %not Pntr_next == Nil %and Found = no %cycle Pntr == Pntr_next %if %not Box not in Window(Pntr_oriX,Pntr_oriY, Pntr_endX,Pntr_endY) %start %if Point_X >= Pntr_oriX %and Point_X <= Pntr_endX %start %if Point_Y >= Pntr_oriY %and Point_Y <= Pntr_endY %then %c Found = yes %finish %finish %repeat write1(Pntr_oriX,4); write1(Pntr_oriY,4); newline2 %end Pntr == Current Symbol_boxes %cycle Select Box(Point,Found) %if Found = yes %start Disable RBG Planes Clear Cursor Set Colour(8) Box1(Pntr_oriX,Pntr_oriY, Pntr_endX,Pntr_endY) Enable All Planes Display Info("Correct ?") Confirm(correct) %if correct = no %start Found = no Status = left %finish Disable RBG Planes Set Colour(0) Box1(Pntr_endX,Pntr_endY,Pntr_oriX,Pntr_oriY) Enable All Planes %finish %repeat %until Correct = yes %or Pntr_next == Nil %if Found = yes %then %result == Pntr %else %c %result == Nil %end %external %record(Text Item) %map Choose Text(%record(PointFM) Point) %label Abort %byte Found %integer Status, Lngth, Ht, Offset, Correct = no %record(Text Item) %name Pntr %routine Select Text(%record(PointFM) Point,%byte %name Found) %integer No Chars,EndX,TopY,Char Ht Prstring("Select Text called"); newline2 Found = no %while %not Pntr_next == Nil %and Found = no %cycle Pntr == Pntr_next %if Point_X >= Pntr_oriX %and Point_X <= Pntr_endX %start %if Point_Y >= Pntr_oriY %and Point_Y <= Pntr_endY %then %c Found = Yes %finish %repeat %end Mouse Info("FIX","FIX","ABORT") Pntr == Current Symbol_text %cycle Select Text(Point,Found) %if Found = yes %start Lngth = Pntr_endX - Pntr_oriX Ht = Pntr_endY - Pntr_oriY Prstring("Character size= "); write1(Pntr_size,5) newline2 Offset = Int(0.365 * Ht) Disable RBG Planes Clear Cursor Set Colour(8) Move Abs(Pntr_oriX,Pntr_oriY + Offset) Line Rel(Lngth//2,0) Enable All Planes Display Info("Correct ?") Confirm(correct) %if correct = no %start Found = no Status = left %finish Disable RBG Planes Set Colour(0) Move Abs(Pntr_oriX,Pntr_oriY + Offset) Line Rel(Lngth//2,0) Enable All Planes %finish %repeat %until Correct = yes %or Pntr_next == Nil abort: %if Found = yes %then %result == Pntr %else %result == Nil %end %external %record(Circle Item) %map Choose Circle(%record(PointFM) Point) %byte Found =no %integer Status,Correct = no %record(Circle Item) %name Pntr Prstring("Choose circle called"); newline2 %if Current Symbol_circles_next ## Nil %start Pntr == Current Symbol_Circles %cycle Found = no %while Found = no %and Pntr_next ## Nil %cycle Pntr == Pntr_next %if Point_X >= Pntr_oriX - Pntr_radius %and %c Point_X <= Pntr_oriX + Pntr_radius %start %if Point_Y >= Pntr_oriY - Pntr_radius %and %c Point_Y <= Pntr_oriY + Pntr_radius %then %c Found = yes %finish %repeat %if Found = yes %start Disable RBG Planes Clear Cursor Set Colour(8) Move Abs(Pntr_oriX,Pntr_oriY) Circle(Pntr_radius) Enable All Planes Display Info("Correct ?") Confirm(correct) Disable RBG Planes Clear Cursor ! Set Colour(0) ! Move Abs(Pntr_oriX,Pntr_oriY) ! Circle(Pntr_radius) Enable All Planes %finish %exit %if Pntr_next == Nil %repeat %until Correct = yes %finish Prstring("Correct = "); write1(correct,5); newline2 %if Correct = yes %then %result == Pntr %else %c %result == Nil %end %external %routine Change Instance Count(%byte direction) ! Changes the number of recorded instances of the current symbol and any ! symbols that make up the current symbol. %record(Symbol) %name Last CS %record(Symbol Instance) %name Pntr prstring("Change instance count called"); newline2 Prstring("Initially instance count -"); write1(Current symbol_instances,5) newline2 %if Direction = up %then Prstring("Up") %else Prstring("Down"); newline2 %if Direction = Up %then %c Current Symbol_instances = Current Symbol_instances + 1 %c %else Current symbol_instances = Current symbol_instances - 1 Prstring("Current Symbol = ".Current symbol_name); newline2 Prstring("New value ="); write1(Current symbol_instances,5); newline2 %if Current Symbol_symbols_next ## Nil %start Pntr == Current Symbol_symbols %cycle Pntr == Pntr_next Last CS == Current Symbol Prstring("P_TE_S_next ## Nil"); newline2 Current Symbol == Pntr_table entry Change Instance Count(direction) Current Symbol == Last CS %repeat %until Pntr_next == Nil %finish %end %external %routine Next Routine(%integer %name Item,Status, %record(PointFM) %name Point) %record(PointFM) Screen Point Prstring("Next routine called");newline2 Show Cursor(Status,Point) Screen Point = Point Map to Screen(Screen Point) Item = Menu Item(Screen Point) write1(item,5); newline2 %end %external %routine Position Box(%integer %name Status, %record(PointFM) %name Cursor, %integer B length,B Ht) %integer OK Prstring("Position Box called"); newline2 %cycle Display Info("Fix new position.") Mouse Info("Fix","Fix","Abort") write1(B Ht,5); write1(B length,5); newline2 Show C Box Cursor(B Ht,B length,Status,Cursor) Clear Cursor %if Status = right %start %return %finish Disable RBG Planes Set Colour(8) Box1(Cursor_X,Cursor_Y,Cursor_X + B length,Cursor_Y + B Ht) Display Info("OK ?") Confirm(OK) Clear Cursor Clear Info; Clear Mouse Info %repeat %until OK = yes %end %external %routine Position Circle(%integer %name Status,radius, %record(PointFM) %name Cursor) %integer OK Prstring("Position Circle called"); newline2 %cycle Display Info("Fix new position.") Mouse Info("Fix","Fix","Abort") Show C Circle Cursor(Status,radius,Cursor) Clear Cursor %if Status = right %start %return %finish Disable RBG Planes Set Colour(8) NCircle(Cursor_X,Cursor_Y,radius) Display Info("OK ?") Confirm(OK) Clear Cursor Clear Info; Clear Mouse Info %repeat %until OK = yes %end %external %routine Symbol to New Position(%integer %name Status, %record(PointFM) %name BL,TR) Clear Cursor Display Info("Exact replica or scaled ?") %cycle Choose from(Status,"Exact"," ","Scaled") %repeat %until Status = left %or Status = right %if Status = left %start Position Box(Status,BL,TR_X,TR_Y) %if Status = right %start Clear Cursor %return %finish TR_X = BL_X + TR_X TR_Y = BL_Y + TR_Y Clear Info; Clear Mouse Info %finish %else %start Define Area(BL,TR,Status) %finish %end %external %routine Delete Item in(%byte Table type) %integer Status, repeat %record(Symbol) %name ST Pntr %routine Delete Lines %record(Line Item) %name Pntr, Next item Prstring("Delete lines called"); newline2 %if %not ST Pntr_lines_next == Nil %start Pntr == ST Pntr_lines Next item == Pntr_next %cycle Pntr == Next Item Next Item == Pntr_next Dispose(Pntr) %repeat %until Next item == Nil %finish %end %routine Delete Boxes %record(Box Item) %name Pntr, Next item Prstring("Delete Boxes called"); newline2 %if %not ST Pntr_boxes_next == Nil %start Pntr == ST Pntr_boxes Next Item == Pntr_next %cycle Pntr == Next Item Next Item == Pntr_next Dispose(Pntr) %repeat %until Next Item == Nil %finish %end %routine Delete Text %integer Top, Rt End %record(Text Item) %name Pntr, Next Item %if %not ST Pntr_text_next == Nil %start Pntr == ST Pntr_text Next Item == Pntr_next %cycle Pntr == Next Item Next Item == Pntr_next Dispose(Pntr) %repeat %until Next Item == Nil %finish %end %routine Delete Circles %record(Circle Item) %name Pntr,Next Item %if %not ST Pntr_Circles_next == Nil %start Pntr == ST Pntr_Circles Next Item == Pntr_next %cycle Pntr == Next Item Next Item == Pntr_next Dispose(Pntr) %repeat %until Next Item == Nil %finish %end %routine Delete Symbols %record(Symbol) %name Last CS %record(Symbol Instance) %name Pntr, Next Item %if %not ST Pntr_symbols_next == Nil %start Pntr == ST Pntr_symbols Next Item == Pntr_next %cycle Pntr == Next Item Next Item == Pntr_next Last CS == Current Symbol Current Symbol == Pntr_table entry Change Instance Count(Down) Current Symbol == Last CS Dispose(Pntr) %repeat %until Next Item == Nil %finish %end Prstring("Delete Item called"); newline2 Enable All Planes %cycle Clear Info; Clear Mouse Info ST Pntr == Choose Sym by name(Table type) Display Main Menu %if ST Pntr == Nil %start %return %finish %if ST Pntr_name # Current symbol_name %and %c ST Pntr_name # Current page_name %start %if ST Pntr_instances = 0 %start Delete lines Delete Boxes Delete Text Delete Circles Delete Symbols ST Pntr_last_next == ST Pntr_next %if ST Pntr_next ## Nil %then %c ST Pntr_next_last == ST Pntr_last Dispose(ST Pntr) %finish %else %start Error message(ST Pntr_name." is still in use.") %finish %finish %else %start Error Message(ST Pntr_name." is still in use.") %finish Display Info("Repeat ?") Confirm(repeat) %repeat %until repeat = no %end %external %routine Duplicate Item in(%byte Table type) %integer Status %record(Symbol) %name Last CS, ST Pntr, Instn Pnt %string(80) name %routine Duplicate Lines %record(PointFM) ori,end %record(Line Item) %name Pntr Prstring("Duplicate lines called"); newline2 %if %not ST Pntr_lines_next == Nil %start Pntr == ST Pntr_lines %cycle Pntr == Pntr_next ori_X = Pntr_oriX; ori_Y = Pntr_oriY end_X = Pntr_endX; end_Y = Pntr_endY Store line(ori,end,Pntr_colour) %repeat %until Pntr_next == Nil %finish %end %routine Duplicate Boxes %record(PointFM) ori,end %record(Box Item) %name Pntr Prstring("Duplicate Boxes called"); newline2 %if %not ST Pntr_boxes_next == Nil %start Pntr == ST Pntr_boxes %cycle Pntr == Pntr_next ori_X = Pntr_oriX; ori_Y = Pntr_oriY end_X = Pntr_endX; end_Y = Pntr_endY Store Box(ori,end,Pntr_colour) %repeat %until Pntr_next == Nil %finish %end %routine Duplicate Text %record(PointFM) ori,end %record(Text Item) %name Pntr %if %not ST Pntr_text_next == Nil %start Pntr == ST Pntr_text %cycle Pntr == Pntr_next ori_X = Pntr_oriX; ori_Y = Pntr_oriY end_X = Pntr_endX; end_Y = Pntr_endY Store text(ori,end,Pntr_text,Pntr_size,Pntr_font,Pntr_colour) %repeat %until Pntr_next == Nil %finish %end %routine Duplicate Circles %record(Circle Item) %name Pntr %if %not ST Pntr_Circles_next == Nil %start Pntr == ST Pntr_Circles %cycle Pntr == Pntr_next Store circle(Pntr_oriX,Pntr_oriY,Pntr_radius,Pntr_colour) %repeat %until Pntr_next == Nil %finish %end %routine Duplicate Symbols %record(Symbol Instance) %name Pntr, I Pntr %record(Symbol) %name Last CS %if %not ST Pntr_symbols_next == Nil %start Pntr == ST Pntr_symbols %cycle Pntr == Pntr_next Last CS == Current Symbol Current Symbol == Pntr_table entry Change Instance Count(Up) Current Symbol == Last CS I Pntr == Store symbol instance(Pntr_oriX,Pntr_oriY, Pntr_endX,Pntr_endY) I Pntr_table entry == Pntr_table entry %repeat %until Pntr_next == Nil %finish %end Prstring("Duplicate Item called"); newline2 Enable All Planes Clear Info; Clear Mouse Info ST Pntr == Choose Sym by name(Table type) Display Main Menu %if ST Pntr == Nil %start %return %finish Last CS == Current Symbol Current Symbol == New(Current Symbol) Current Symbol = 0 Current Symbol_length = ST Pntr_length Current Symbol_Ht = ST Pntr_Ht Current Symbol_type = ST Pntr_type Duplicate lines Duplicate Boxes Duplicate Text Duplicate Circles Duplicate Symbols ST Pntr == Current Symbol Current Symbol == Last CS %if Table type = Symbol table %then %c Display Info("Please enter name of symbol. Maximum of 10 characters.")%c %else %c Display Info("Please enter name of page. Maximum of 10 characters.") Read from terminal(name) %if length(name) > 10 %then name = substring(name,1,10) ST Pntr_name = name Instn Pnt == Find Insertion Point(ST Pntr_name,Table type) ST Pntr_last == Instn Pnt ST Pntr_next == Instn Pnt_next %if Instn Pnt_next ## Nil %then %c Instn Pnt_next_last == ST Pntr Instn Pnt_next == ST Pntr %end %external %routine Read Item Into(%integer Table type) %record %format Symbol name(%string(10) name, %record(Symbol name) %name last,next, %record(Symbol) %name Table Pntr) %record(Symbol name) Base Name List=0 %record(Symbol) %name Item, CS on entry %string(80) filename, Sym name %string(10) S name %label Abort,Retry2 %record(Symbol) %Map Read in Symbol(%string(10) name,%integer Table) %record(Symbol) %name Pntr, Instn Pnt, Last CS %record(Symbol name) %name Item %record(Symbol Instance) %name Last %string(80) Instance name %string(10) Temp name, Inst name %integer Ht, Lngth,oriX,oriY,endX,endY,Type %record(Symbol name) %map Add to name list(%string(10) name) %record(Symbol name) %name New Item Prstring("Add to name list called"); newline2 New Item == New(New Item) New Item_name = name New Item_last == Base Name List New Item_next == Base Name List_next %if New Item_next ## Nil %then %c New Item_next_last == New Item Base Name List_next == New Item Prstring("Name stored = ".New Item_name); newline2 %result == New Item %end %predicate Symbol not read in(%string(10) name) %record(Symbol name) %name Pntr %byte found = no Prstring("Symbol not read in called"); newline2 Pntr == Base Name List %while Pntr_next ## Nil %and found = no %cycle Pntr == Pntr_next Prstring("Name in table = ".Pntr_name); newline2 %if Pntr_name = name %then found = yes %repeat %true %if found = no %false %end %routine Next Char %integer n n = Nextsymbol %while n < 33 %or n >126 %cycle readsymbol(n) n = nextsymbol %repeat %end %routine Pass Star %cycle Next Char %repeat %until nextsymbol = '*' Skipsymbol Next Char %end %routine Read in Lines %record(PointFM) ori,end %integer colour Pass Star Prstring("Lines"); newline2 %while Nextsymbol # '*' %cycle read(ori_X); read(ori_Y); read(end_X); read(end_Y) read(colour); Next Char write1(ori_X,5); write1(ori_Y,5) write1(end_X,5); write1(end_Y,5) write1(colour,5); newline2 Store line(ori,end,colour) %repeat %end %routine Read in Boxes %record(PointFM) ori,end %integer colour Pass Star Prstring("Boxes"); newline2 %while Nextsymbol # '*' %cycle read(ori_X); read(ori_Y); read(end_X); read(end_Y) read(colour); Next Char write1(ori_X,5); write1(ori_Y,5) write1(end_X,5); write1(end_Y,5) write1(colour,5); newline2 Store Box(ori,end,colour) %repeat %end %routine Read in Text %string(80) text %record(PointFM) ori,end %integer font,colour,size Pass Star Prstring("Text"); newline2 %while Nextsymbol # '*' %cycle read(ori_X); read(ori_Y); read(end_X); read(end_Y) Next Char write1(ori_X,5); write1(ori_Y,5) write1(end_X,5); write1(end_Y,5); newline2 read(size); read(font); read(colour) Next Char write1(size,5); write1(font,5); write1(colour,5) newline2 Read Text(text) Next Char Prstring(text); newline2 Store text(ori,end,text,size,font,colour) %repeat %end %routine Read in Circles %integer oriX,oriY,radius,colour Pass Star Prstring("Circles"); newline2 %while Nextsymbol # '*' %cycle read(oriX); read(oriY); read(radius); read(colour) Next Char write1(oriX,5); write1(oriY,5); write1(radius,5) write1(colour,5); newline2 Store Circle(oriX,oriY,radius,colour) %repeat %end %record(Symbol Instance) %map Create Symbol Instance %c (%integer oriX,oriY,endX,endY, %string(10) symbol name) %record(Symbol Instance) %name Pntr Pntr == New(Pntr) Pntr_oriX = oriX; Pntr_oriY = oriY Pntr_endX = endX; Pntr_endY = endY Pntr_symbol name = Symbol name Pntr_last == Last Pntr_next == Nil Last_next == Pntr Prstring("Symbol dimensions"); newline2 write1(Pntr_oriX,5); write1(Pntr_oriY,5) write1(Pntr_endX,5); write1(Pntr_endY,5) newline2 Prstring("Symbol name= ".Pntr_symbol name) newline2 %result == Pntr %end %record(Symbol) %map Get Symbol from Table(%string(10) name) %record(Symbol name) %name Pntr Pntr == Base Name List %while Pntr_next_name # name %cycle Pntr == Pntr_next %repeat %result == Pntr_next_Table Pntr %end %routine Read in Component Symbols %record(Symbol Instance) %name Pntr %record(Symbol) %name Last CS, Sym Prstring("Read in component symbols called"); newline2 %if %not Current Symbol_symbols_next == Nil %start Pntr == Current Symbol_symbols %cycle Pntr == Pntr_next %if Symbol not read in(Pntr_symbol name) %start Prstring(Pntr_symbol name." not read in");newline2 Sym == Read In Symbol(Pntr_symbol name,Symbol Table) Prstring("Read in symbol finished"); newline2 %finish %else %start Prstring(Pntr_symbol name." read in");newline2 Sym == Get Symbol from table(Pntr_symbol name) Prstring("Get symbol from table finished") newline2 %finish Pntr_table entry == Sym Last CS == Current Symbol Current Symbol == Sym Change Instance Count(Up) %while Pntr_next##nil %and Pntr_next_symbol name = Sym_name %cycle Pntr == Pntr_next Pntr_table entry == Sym Change Instance Count(Up) %repeat Current Symbol == Last CS %repeat %until Pntr_next == Nil %finish %end %routine Find Symbol(%string(10) name) %integer Char %string(80) Symbol name Prstring("Find Symbol called"); newline2 Prstring("Looking for ".name); newline2 %cycle %cycle Readsymbol(Char) ! Prstring("First Char= "); Printsymbol(Char) newline2 %while Char # '$' %cycle Readsymbol(Char) %repeat Read Text(Symbol name) Prstring("Symbol found= ".Symbol name); newline2 %repeat %until Symbol name = name Read(Type) Prstring("Type & Type looking for."); newline2 write1(Type,5); write1(Table,5); newline2 %repeat %until Type = Table Prstring("Name found= ".Symbol name); newline2 %end Last CS == Current Symbol Pntr == New(Pntr) Pntr = 0 Current Symbol == Pntr Find Symbol(Name) Read(Lngth); Read(Ht) write1(Lngth,5); write1(Ht,5); newline2 Pntr_type = Type Pntr_length = Lngth Pntr_Ht = Ht Next Char Read in lines Read in Boxes Read in Text Read in Circles Prstring("Symbols"); newline2 Prstring("Current symbol_name= ". %c Current Symbol_name) newline2 Last == Current Symbol_symbols Pass Star %while Nextsymbol # '*' %cycle Read Text(Instance name) Next Char Prstring(Instance name); newline2 read(oriX); read(oriY); read(endX); read(endY) Next Char write1(oriX,5); write1(oriY,5) write1(endX,5); write1(endY,5); newline2 Inst name = Substring(Instance name,1,length(Instance name)) Last == Create Symbol Instance(oriX,oriY,endX,endY,Inst name) Prstring("Last= ".Last_symbol name); newline2 Prstring(Last_symbol name); newline2 write1(Last_oriX,5); write1(Last_oriY,5) write1(Last_endX,5); write1(Last_endY,5); newline2 %repeat Read in Component Symbols Select Input(0) Temp name = name Instn Pnt == Find Insertion Point(Temp name,Table) Select Input(1) Pntr_last == Instn Pnt Pntr_next == Instn Pnt_next %if Pntr_next ## Nil %then %c Pntr_next_last == Pntr Instn Pnt_next == Pntr Item == Add to name list(Name) Item_Table Pntr == Pntr Pntr_name = Temp name Current Symbol == Last CS %result == Pntr %end %on %event 3,9 %start Prstring("Event 9.") write1(event_sub,1); newline2 !DAK %if Event_sub = 1 %start %if Event_Event = 9 %start !** above line modified because 9 has no subevent significance. DAK 29/04/85 Error Message("End of file: """.S name.""" not found") Current Symbol == CS on Entry -> Abort %finish %else %if Event_Event=3 %or Event_Sub = 3 %start Error Message("File """.filename.""" not found") Select Input(0) -> Retry2 %finish %finish Retry1: Clear Cursor Clear Mouse Info Display Main menu %if Table type = Page table %start Display Info("Enter Page name.") %finish %else %start Display Info("Enter Symbol name.") %finish Prstring("Initially Type looking for=") Read from terminal(Sym name) Clear Input !DAK To Upper (Sym name) !** above commented out because inconsistent case significance policy !** with save routine. DAK 29/04/85 %if Sym name = "ABORT" %then -> Abort %if length(Sym name) > 10 %start Error Message("ERROR: Symbol name is too long.") -> Retry1 %finish S Name = Substring(Sym name,1,length(Sym name)) Retry2: Display Info("Enter filename.") Move to(1,9) Clear Line Read(Filename) Clear Input Move To(V200X,V200Y) To Upper (Filename) %if Filename = "ABORT" %then -> Abort Select Input(1) Open Input(1,filename) CS on Entry == Current Symbol Item == Read in Symbol(S name,Table type) Current Symbol == CS on Entry Abort: Select Input(1) Close Input Select Input(0) !DAK above line added to redirect input to come from terminal. DAK 29/04/85 Open Input(0,":") %end %external %routine Save Item In(%integer Table type) %record %format Symbol name(%string(10) name, %record(Symbol name) %name last,next) %record(Symbol name) Base Name List=0 %record(Symbol) %name Item Chosen, Last CS %string(255) filename %label Retry %routine Save Current Symbol %record(Symbol) %name Pntr %routine Add to name list(%string(10) name) %record(Symbol name) %name New Item New Item == New(New Item) New Item_name = name New Item_last == Base Name List New Item_next == Base Name List_next %if New Item_next ## Nil %then %c New Item_next_last == New Item Base Name List_next == New Item %end %predicate Symbol not saved(%string(10) name) %record(Symbol name) %name Pntr %byte found = no Pntr == Base Name List %while Pntr_next ## Nil %and found = no %cycle Pntr == Pntr_next %if Pntr_name = name %then found = yes %repeat %true %if found = no %false %end %routine Save Lines %record(Line Item) %name Pntr Printsymbol('*'); Newline %if %not Current Symbol_lines_next == Nil %start Pntr == Current Symbol_lines %cycle Pntr == Pntr_next write(Pntr_oriX,1); write(Pntr_oriY,1) write(Pntr_endX,1); write(Pntr_endY,1) write(Pntr_colour,1); Newline %repeat %until Pntr_next == Nil %finish %end %routine Save Boxes %record(Box Item) %name Pntr Printsymbol('*'); Newline %if %not Current Symbol_boxes_next == Nil %start Pntr == Current Symbol_boxes %cycle Pntr == Pntr_next write(Pntr_oriX,1); write(Pntr_oriY,1) write(Pntr_endX,1); write(Pntr_endY,1) write(Pntr_colour,1); Newline %repeat %until Pntr_next == Nil %finish %end %routine Save Text %record(Text Item) %name Pntr Printsymbol('*'); Newline %if %not Current Symbol_text_next == Nil %start Pntr == Current Symbol_text %cycle Pntr == Pntr_next write(Pntr_oriX,1); write(Pntr_oriY,1) write(Pntr_endX,1); write(Pntr_endY,1); Newline write(Pntr_size,1); write(Pntr_font,1); write(Pntr_colour,1) Newline Printstring(Pntr_text); Newline %repeat %until Pntr_next == Nil %finish %end %routine Save Circles %record(Circle Item) %name Pntr Printsymbol('*'); Newline %if %not Current Symbol_Circles_next == Nil %start Pntr == Current Symbol_Circles %cycle Pntr == Pntr_next write(Pntr_oriX,1); write(Pntr_oriY,1) write(Pntr_radius,1); write(Pntr_colour,1); Newline %repeat %until Pntr_next == Nil %finish %end %routine Save Symbol Names %record(Symbol Instance) %name Pntr Printsymbol('*'); Newline %if %not Current Symbol_symbols_next == Nil %start Pntr == Current Symbol_symbols %cycle Pntr == Pntr_next printstring(Pntr_table entry_name); Newline write(Pntr_oriX,1); write(Pntr_oriY,1) write(Pntr_endX,1); write(Pntr_endY,1) Newline %repeat %until Pntr_next == Nil %finish Printsymbol('*'); Newline %end %routine Save Component Symbols %record(Symbol Instance) %name Pntr %record(Symbol) %name Last CS %if %not Current Symbol_symbols_next == Nil %start Last CS == Current Symbol Pntr == Current Symbol_symbols %cycle Pntr == Pntr_next Current Symbol == Pntr_table entry Save Current Symbol %repeat %until Pntr_next == Nil Current Symbol == Last CS %finish %end Pntr == Current Symbol %if Symbol not Saved(Pntr_name) %start Add to name list(Pntr_name) Printsymbol('$'); Newline printstring(Pntr_name); Newline write(Pntr_type,1); Newline write(Pntr_length,1); write(pntr_Ht,1); Newline Save lines Save Boxes Save Text Save Circles Save Symbol names Save Component Symbols %finish %end %on %event 3,9 %start Select Output(0) Error Message("ERROR: File cannot be opened.") -> Retry %finish Clear Cursor Enable All Planes Clear Info; Clear Mouse Info Item Chosen == Choose Sym by name(Table type) Display Main Menu %return %if Item Chosen == Nil Retry: Display Info("Enter file name.") Move To(1,9) Clear Line read(filename) Move To(V200X,V200Y) toupper (filename) %return %if filename = "ABORT" Last CS == Current Symbol Current Symbol == Item Chosen Select Output(2) %if Table type = Symbol table %start Open Append(2,filename) Save Current Symbol Close Append Select Output(0) %finish %else %start Open Output(2,filename) Save Current Symbol Close Output Select Output(0) %finish Current Symbol == Last CS %end %endoffile