%include "src:util.imp" %include "edwin:consts.inc" %include "edwin:specs.inc" %include "edwin:types.inc" %include "edwin:shapes.inc" %include "drawdec.inc" %begin %external %integer %array %spec Menu(1:15) %external %byte %array %spec X Pnts(0:1680) %external %byte %array %spec Y Pnts(0:1190) %external %integer %spec End Program, Curr Colour, Curr Char Size,Curr Char Font, Curr Char Rot, Grid On, Currentcolour, Diag on, Grid Interval, Scale Line Length, V200X, V200Y, VPXL, VPXR, VPYB, VPYT, {Viewport} DWXL, DWXR, DWYB, DWYT {Drawing Window} %external %record(Symbol) %spec Base Page Table, Base Symbol Table %external %record(Symbol) %name %spec Current Symbol, Current Page !------------------------------------------------------------- %external %routine %spec ESC %external %routine %spec Clear Screen %external %routine %spec Move To(%integer X,Y) %external %routine %spec Clear Line %external %routine %spec printstring1(%string(255) S) %external %routine %spec Scroll(%integer Top,Bottom) %external %routine %spec newline1 %external %routine %spec newline2 !------------------------------------------------------------- %external %routine %spec Prstring(%string(255) string) %external %routine %spec Write1(%integer number,places) %external %predicate %spec L or R Pressed(%integer Status) %external %predicate %spec L or C or R Pressed(%integer Status) %external %predicate %spec T to B(%integer oriY,endY) %external %predicate %spec Vertical line(%integer oriX,endX) %external %predicate %spec L to R(%integer oriX,endX) %external %predicate %spec Horizontal line(%integer oriY,endY) %external %predicate %spec Between A and B(%integer Point,A,B) %external %predicate %spec Point Chosen(%record(PointFM)Point) %external %predicate %spec On Page(%record(PointFM) Point) %external %predicate %spec In DW(%record(PointFM) Point) %external %predicate %spec In VP(%record(PointFM) Point) %external %predicate %spec Valid Font(%integer font) !------------------------------------------------------------- %external %integer %function %spec Max(%integer A,B) %external %integer %function %spec Min(%integer A,B) %external %real %function %spec Min1(%real A,B) %external %byte %function %spec Menu Item(%record(PointFM) Point) %external %integer %function %spec Text length(%string(80) Word) %external %routine %spec read font %external %routine %spec at(%integer x,y) %external %routine %spec showsymbol(%integer k) %external %routine %spec showstring(%string(255)s) %external %routine %spec Enable AllPlanes %external %routine %spec Disable RBG planes %external %routine %spec Clear Cursor %external %routine %spec Clear Area(%integer XL,YB,XR,YT) %external %routine %spec Clear Window Area(%integer XL,YB,XR,YT) %external %routine %spec Clear Drawing Area %external %routine %spec Clear Info %external %routine %spec Clear Page name %external %routine %spec Clear Page size %external %routine %spec Clear Mouse Info %external %routine %spec Clear Menu %external %routine %spec Place Word(%string(255) Word,%integer X,Y) %external %routine %spec Display Info(%string(255) Info) %external %routine %spec Display Name of Page(%string(10) Page name) %external %routine %spec Display Page Size(%integer Size) %external %routine %spec Mouse Info(%String(10) L, C, R) %external %routine %spec Error Message(%string(255) message) %external %routine %spec Display Menu(%string(10) %array %name Words(1:12)) %external %routine %spec Display Main menu %external %routine %spec Clear Input %external %routine %spec Clear S Marker(%byte item) %external %routine %spec Box1(%integer BLX,BLY,TRX,TRY) %external %routine %spec Box2(%integer XL,YB,XR,YT) %external %routine %spec Swop(%integer %name end1,end2) %external %routine %spec Delay %external %routine %spec Map to Screen(%record(PointFM) %name Point) !------------------------------------------------------------ %external %routine %spec Clear Grid %external %routine %spec Draw X Scale(%integer Colour,Interval) %external %routine %spec Draw Y Scale(%integer Colour,Interval) %external %routine %spec Remove Grid %external %routine %spec Draw Grid %external %routine %spec Set Grid %external %routine %spec Set to Grid Point(%record(PointFM) %name Point) %external %routine %spec Confirm(%integer %name Status) %external %routine %spec Choose from(%integer %name Status,%string(10) ML,MC,MR) %external %routine %spec Draw Hairline(%record(PointFM) Point) %external %routine %spec Clear Hairline(%record(PointFM) Point) %external %routine %spec Hairline Cursor(%record(PointFM) Old, Cursor) %external %routine %spec Print Cross(%integer X,Y) %external %routine %spec Draw Cursor(%record(PointFM) Point) %external %routine %spec Clear Cursor1(%record(PointFM) Point) %external %routine %spec Remove Hairline(%record(PointFM) Point) %external %routine %spec Remove Cursor(%record(PointFM) Point) %external %routine %spec Small Cursor(%record(PointFM) Old, Point) %external %routine %spec Clear top %external %routine %spec Clear Bottom %external %routine %spec Up Arrow(%integer X,Y) %external %routine %spec Down Arrow(%integer X,Y) %external %routine %spec Left Arrow(%integer X,Y) %external %routine %spec Right Arrow(%integer X,Y) %external %routine %spec Up Pointer %external %routine %spec Down Pointer %external %routine %spec Left Pointer %external %routine %spec Right Pointer %external %routine %spec Ncircle(%integer X,Y,radius) %external %routine %spec Cursor1(%record(PointFM) Point) %external %routine %spec Show Cursor(%integer %name Button, %record(PointFM) %name Point) %external %routine %spec Screen Cursor(%integer %name Status1, %record(PointFM) %name Point) %external %routine %spec Show Cursor1(%integer %name Status1, %record(PointFM) %name Cursor1) %external %routine %spec Show Cursor2(%integer %name Status2, %record(PointFM) %name Cursor2) %external %routine %spec Show Line Cursor(%integer %name Status, %record(PointFM) ori, %record(PointFM) %name Cursor) %external %routine %spec Show A Line Cursor(%integer %name Status1, %record(PointFM) ori1, %record(PointFM) %name Cursor1) %external %routine %spec Show Box Cursor(%integer %name Buttons, %record(PointFM) ori, %record(PointFM) %name Point) %external %routine %spec Show A Box Cursor(%integer %name Status1, %record(PointFM) %name ori, %record(PointFM) %name Cursor1) %external %routine %spec Show B Box Cursor(%integer %name Ht,L,Status, %record(PointFM) %name Cursor) %external %routine %spec Show C Box Cursor(%integer %name Ht,L,Status1, %record(PointFM) %name Cursor1) %external %routine %spec Show Circle Cursor(%integer %name Status,radius, %record(PointFM) ori,Cursor) %external %routine %spec Show A Circle Cursor(%integer %name Status1,radius1, %record(PointFM) ori, %record(PointFM) %name Cursor1) %external %routine %spec Show B Circle Cursor(%integer %name Status,radius, %record(PointFM) %name Point) %external %routine %spec Show C Circle Cursor(%integer %name Status1,Radius1, %record(PointFM) %name Cursor1) !--------------------------------------------------------------- %external %routine %spec Store Line(%record(PointFM) ori,end,%integer Colour) %external %routine %spec Store Box(%record(PointFM) ori,end,%integer Colour) %external %routine %spec Store Text(%record(PointFM) ori,end,%string(80) text, %integer Size,Font,Colour) %external %routine %spec Store Circle(%integer oriX,oriY,radius,colour) %external %record(Symbol instance) %map %spec %c Store Symbol Instance(%integer oriX,oriY, endX,endY) %external %record(Symbol) %map %spec %c Find Insertion Point(%string(10) %name name, %byte List type) !----------------------------------------------------------- %external %routine %spec Redraw Symbol(%integer oriX,oriY,endX,endY) %external %routine %spec Redraw Grid(%integer AXL,AYB) %external %routine %spec Redraw Area(%integer AXL,AYB,AXR,AYT, IXL,IYB,IXR,IYT) %external %routine %spec Redraw Box Area(%integer XL,YB,XR,YT) %external %routine %spec PDF One Colour(%integer Colour,oriX,oriY,endX,endY) !--------------------------------------------------------------------- %external %routine %spec Define Area(%record(PointFM) %name BL Corner,TR Corner, %integer %name Status) !--------------------------------------------------------------------- %external %record(Symbol) %map %spec Create Symbol %external %routine %spec Find Limits(%integer %name oriX,oriY,endX,endY) %external %routine %spec Convert to Rel Coords(%integer oriX,oriY) !------------------------------------------------------------- %external %routine %spec Set Page(%integer XL,XR,YB,YT) %external %routine %spec Set Window(%integer XL,YB,XR,YT) %external %routine %spec Set Max Viewport(%integer XL,YB,XR,YT) %external %routine %spec Set Lifesize Viewport(%integer XL,YB,XR,YT) %external %routine %spec Set A4(%integer %name L,Ht) %external %routine %spec Set Slide(%integer %name L,Ht) %external %routine %spec Set A3(%integer %name L,Ht) !------------------------------------------------------------- %external %record(Line Item) %Map %spec %c Choose Line(%record(PointFM) Point) %external %record(Box Item) %map %spec %c Choose Box(%record(PointFM) Point) %external %record(Text Item) %map %spec %c Choose Text(%record(PointFM) Point) %external %record(Circle Item) %map %spec %c Choose Circle(%record(PointFM) Point) %external %record(Symbol) %map %spec %c Choose Sym by name(%integer Table type) %external %record(Symbol Instance) %map %spec %c Choose Symbol Instance(%integer oriX,oriY, %record(PointFM) Point) %external %routine %spec Change Instance Count(%byte direction) %external %routine %spec Read Text(%string(80) %name text) %external %routine %spec Read from Terminal(%string(80) %name string) %external %routine %spec Next Routine(%integer %name Item,Status, %record(PointFM) %name Point) %external %routine %spec Position Box(%integer %name Status, %record(PointFM) %name Cursor, %integer B length,B Ht) %external %routine %spec Position Circle(%integer %name Status,radius, %record(PointFM) %name Cursor) %external %routine %spec Symbol to New Position(%integer %name Status, %record(PointFM) %name BL,TR) %external %routine %spec Delete Item in(%byte Table type) %external %routine %spec Duplicate Item in(%byte Table type) %external %routine %spec Read Item Into(%integer Table type) %external %routine %spec Save Item In(%integer Table type) %external %routine %spec PDF Item In(%integer Table type) %integer start, Depth=1{Depth = Depth of zoom stack.} %routine %spec Select Option(%integer Item) %label Terminate Program %routine Menu Selection %byte Item %integer Status %record(PointFM) Point Clear Mouse Info Display Info("Select Menu Item") %cycle Screen Cursor(Status,Point) Item = Menu Item(Point) %repeat %until Item # 0 Select Option(Item) %end !%routine Edit Symbol ! %record(Symbol) %name Pntr, Last CS ! %integer Previously Editing Symbol ! %label Abort ! ! Prstring("Edit symbol called"); newline2 ! %if Base Symbol Table_next ## Nil %start ! Previously Editing Symbol = Editing Symbol ! %if Editing Symbol = no %start ! Editing Symbol = yes ! %finish ! Last CS == Current Symbol ! Pntr == Choose Sym by name(Symbol Table) ! Display Main menu ! %if Pntr == Nil %start ! Prstring("Pntr == Nil"); newline2 ! Editing Symbol = Previously editing symbol ! -> Abort ! %finish ! Printstring1("Select ""DONE"" when edit is finished.") ! newline1; newline1 ! Prstring("Symbol chosen= ".Pntr_name); newline2 ! Prstring("Previous symbol was ".Current symbol_name); newline2 ! Current Symbol == Pntr ! Prstring("Current Symbol= ".Current Symbol_name) ! newline2 ! Clear Drawing Area ! Set Window(0,0,Current Symbol_length,Current Symbol_Ht) ! Set Max Viewport(0,0,Current Symbol_length,Current Symbol_Ht) ! Redraw Symbol(0,0,Current Symbol_length,Current Symbol_Ht) ! Draw Grid ! Depth = 1 ! %cycle ! Menu Selection ! %repeat %until Editing Symbol = no ! Current Symbol == Last CS ! Clear Drawing Area ! Set Window(0,0,Current Symbol_length,Current Symbol_Ht) ! Set Max Viewport(0,0,Current Symbol_length,Current Symbol_Ht) ! Redraw Symbol(0,0,Current Symbol_length,Current Symbol_Ht) ! Draw Grid ! Prstring("Previously editing Symbol= ") ! write1(Previously editing symbol,5) ! newline2 ! %if Previously Editing Symbol = no %start ! Display Main Menu ! %finish %else Editing Symbol = yes ! Abort: ! %finish !%end %routine New Page %byte Page size %integer Status %record(Symbol) %name Pntr, Instn Pnt %string(80) name Display Main menu Pntr == New(Pntr) Pntr = 0 Display Info("Choose Page Size.") Choose from(Status,"A4","A3","Slide") %if Status = 1 %then %c Set A4(Pntr_length,Pntr_Ht) %else %c %if Status = 2 %then %c Set A3(Pntr_length,Pntr_Ht) %else %c %if Status = 4 %then %c Set Slide(Pntr_length,Pntr_Ht) newline2 Current Page_instances = 0 Pntr_instances = 1 Pntr_type = Page type Display Info("Please enter name of page. Maximum of 10 characters.") Read from Terminal(name) %if length(name) > 10 %then %c name = Substring(name,1,10) Pntr_name = name Instn Pnt == Find Insertion Point(Pntr_name,Page Table) Pntr_last == Instn Pnt Pntr_next == Instn Pnt_next %if Instn Pnt_next ## Nil %then %c Instn Pnt_next_last == Pntr Instn Pnt_next == Pntr Current Symbol == Pntr Current Page == Pntr Clear Info; Clear Mouse Info Set Window(0,0,Pntr_length,Pntr_Ht) Clear Drawing Area Set Max Viewport(0,0,Pntr_length,Pntr_Ht) Display Name of Page(Pntr_name) Prstring("Page width = "); write1(Pntr_length,5); newline2 %if Pntr_length = 1190 %then Display Page Size(A4) %else %c Display Page Size(Pntr_length) Draw Grid Depth = 1 %end %routine Edit Item in(%integer Table type) %record(Symbol) %name Pntr %label Abort Pntr == Choose Sym by name(Table type) Display Main menu %if Pntr == Nil %start -> Abort %finish %if Table type = Page Table %start Current Page_instances = 0 Current Page == Pntr Current Page_instances = 1 Display Name of Page(Pntr_name) %if Pntr_length = 1190 %then Display Page Size(A4) %else %c Display Page Size(Pntr_length) %finish %else %start Printstring1("To return to editing a page select ""EDIT: Page"".") newline1; newline1 %finish Current Symbol == Pntr Set Window(0,0,Current Symbol_length,Current Symbol_Ht) Clear Drawing Area Set Max Viewport(0,0,Current Symbol_length,Current Symbol_Ht) Draw Grid Redraw Symbol(0,0,Current Symbol_length,Current Symbol_Ht) Depth = 1 Abort: %end %routine New Symbol %label error, Abort %record(Symbol) %name Pntr,Last CS, Instn Pnt %record(Symbol Instance) %name I Pntr %string(80) name %integer oriX,oriY,endX,endY {Test to see if anything} {to define as a symbol.} Printstring1("Draw a box around the items to be defined as a symbol.") Newline1 Printstring1("Hint: Give text a wide berth."); newline1 Newline1 %if Current Symbol_lines_next ## Nil %or %c Current Symbol_boxes_next ## Nil %or %c Current Symbol_text_next ## Nil %or %c Current Symbol_circles_next ## Nil %or %c Current Symbol_symbols_next ## Nil %start Prstring("New symbol called"); newline2 Prstring("Current symbol = ".Current symbol_name); newline2 Pntr == Create Symbol Prstring("Create symbol completed"); newline2 %if Pntr == Nil %start -> Abort %finish {Test to see if symbol is empty.} %if Pntr_lines_next ## Nil %or %c Pntr_boxes_next ## Nil %or %c Pntr_circles_next ## Nil %or %c Pntr_text_next ## Nil %or %c Pntr_symbols_next ## Nil %start Last CS == Current Symbol Current Symbol == Pntr Find Limits(oriX,oriY,endX,endY) Convert to Rel Coords(oriX,oriY) Change Instance Count(Up) Current Symbol == Last CS I Pntr == Store symbol Instance(oriX,oriY,endX,endY) I Pntr_table entry == Pntr Pntr_type = Symbol type Pntr_length = endX - oriX; Pntr_Ht = endY - oriY %if Pntr_length = 0 %then Pntr_length = 1 %if Pntr_Ht = 0 %then Pntr_Ht = 1 Prstring("Size of symbol stored: "); newline2 write1(Pntr_length,5); write1(Pntr_ht,5); newline2 error: Clear Cursor Display Info("Please enter name of symbol. Maximum of 10 characters.") Read from Terminal(name) %if length(name) > 10 %start name = substring(name,1,10) %finish Pntr_name = name Instn Pnt == Find Insertion Point(Pntr_name,Symbol Table) Pntr_last == Instn Pnt {Add symbol to symbol table in correct} Pntr_next == Instn Pnt_next {alphabetic position.} %if Pntr_next ## Nil %then %c Pntr_next_last == Pntr Instn Pnt_next == Pntr Current Symbol == Last CS Abort: %finish %else %start Error Message("No items available to construct symbol.") %finish %finish %end !------------------------------------------------------------- %routine Change Colour %label Abort %byte Button %integer Status,routine %record(PointFM) Dummy Disable RBG Planes Clear Cursor Enable All Planes Display Info("Press M_L or M_C to change colour.") Mouse Info("CHANGE","CHANGE","ABORT") %cycle Button = Mouse Buttons & 2_111 Delay %if Curr Colour # 7 %start Curr Colour = Curr Colour +1 %finish %else Curr Colour = 1 Set Colour(Curr Colour) Fill(85,85,125,105) Next routine(routine,Status,Dummy) %if Status = right %then -> Abort %repeat %until routine # Current Clear Mouse Info Select Option(routine) Abort: %end %routine Display Text Size(%integer Size) Clear Area(90,60,135,80) Set Colour(Lime) Place Word(Itos(Size,3),90,62) Set Colour(Curr Colour) %end %routine Change Char Size %integer Size %label error %on %event 3,4 %start Error Message("ERROR: Non-numeric value") Clear Input -> error %finish Disable RBG Planes Clear Cursor Enable All PLanes error: Clear Mouse Info Display Info("Character size ?") Move To(1,9) Clear line read(Size) Clear Input %if Size < 0 %start Error Message("ERROR: Character size must be positive.") -> error %finish Move To(V200X,V200Y) Display Text Size(Size) Curr Char Size = Size Set Char Size(Curr Char Size) Clear Mouse Info; Clear Info %end %routine Display Text Rot(%integer Rot) Clear Area(90,10,130,30) Set Colour(Lime) Place Word(Itos(Rot,3),90,12) Set Colour(Curr Colour) %end %routine Change Char Rot %integer Rot %label error %on %event 3,4 %start Error Message("ERROR: Non-numeric value") Clear Input -> error %finish Disable RBG Planes Clear Cursor Enable All PLanes error: Clear Mouse Info Display Info("Character Rotation ?") Move To(1,9) Clear line read(Rot) Clear Input %unless 0 <= Rot < 360 %start Error Message("ERROR: Character rotation must be in the range 0 to 359") -> error %finish Move To(V200X,V200Y) Display Text Rot(Rot) Curr Char Rot = Rot Set Char Rot(Curr Char Rot) Clear Mouse Info; Clear Info %end %routine Display Text Font(%integer font) Clear Area(90,35,130,55) Set Colour(Lime) Place Word(ItoS(font,3),90,37) Set Colour(Curr Colour) Clear Info; Clear Mouse Info %end %routine Change Char Font %integer Font %label error %on %event 3,4,9 %start Error Message("ERROR: Non-numeric value") Clear Input -> error %finish Disable RBG PLanes Clear Cursor Enable All Planes Clear Mouse Info error: Display Info("Font Value ?") Move To(1,9) Clear Line read(Font) Move To(V200X,V200Y) Clear Input %if Valid Font(Font) %start Display Text Font(Font) Curr Char Font = Font Set Char Font(Font) %finish %else %start Error Message("ERROR: Invalid Font") -> error %finish Clear Info; Clear Mouse Info %end !----------------------------------------------------------------- %routine Delete Area %label Abort %integer Status, repeat %record(PointFM) BL,TR %routine Delete Lines in Area %record(Line Item) %name Pntr, next %if %not Current Symbol_lines_next == Nil %start Pntr == Current Symbol_lines %cycle Pntr == Pntr_next next == 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 Dispose(Pntr) %finish %finish %finish %finish %repeat %until next == Nil %finish %end %routine Delete Boxes in Area %record(Box Item) %name Pntr, next %if %not Current Symbol_boxes_next == Nil %start Pntr == Current Symbol_boxes %cycle Pntr == Pntr_next next == 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 Dispose(Pntr) %finish %finish %finish %finish %repeat %until next == Nil %finish %end %routine Delete Text in Area %integer Top, Rt End %record(Text Item) %name Pntr, next %if %not Current Symbol_text_next == Nil %start Pntr == Current Symbol_text %cycle Pntr == Pntr_next next == 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 Dispose(Pntr) %finish %finish %finish %finish %repeat %until next == Nil %finish %end %routine Delete Circles in Area %record(Circle Item) %name Pntr, next %if %not Current Symbol_Circles_next == Nil %start Pntr == Current Symbol_Circles %cycle Pntr == Pntr_next next == 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 Dispose(Pntr) %finish %finish %finish %finish %repeat %until next == Nil %finish %end %routine Delete Symbols in Area %record(Symbol Instance) %name Pntr, next %record(Symbol) %name Last CS %if %not Current Symbol_symbols_next == Nil %start Pntr == Current Symbol_symbols %cycle Pntr == Pntr_next next == 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 Last CS == Current symbol Current symbol == Pntr_table entry Change Instance Count(Down) Current symbol == Last CS Pntr_last_next == Pntr_next %if Pntr_next ## Nil %then %c Pntr_next_last == Pntr_last Dispose(Pntr) %finish %finish %finish %finish %repeat %until next == Nil %finish %end %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 %cycle Define Area(BL,TR,Status) %if Status = right %start -> Abort %finish Clear Window Area(BL_X,BL_Y,TR_X,TR_Y) Delete lines in Area Delete Boxes in Area Delete Text in Area Delete Circles in Area Delete Symbols in Area Redraw Area(BL_X,BL_Y,TR_X,TR_Y,0,0, Current Symbol_length,Current Symbol_Ht) Redraw Grid(BL_X,BL_Y) Display Info("Repeat ?") Confirm(repeat) Clear Mouse Info %repeat %until repeat = no Abort: %finish %end !----------------------------------------------------------------- %routine Draw Line %record(PointFM) Cursor,Marker %integer Stop,routine, Status %label Abort1 Display Main menu Printstring1("When initial point has been fixed:"); newline1 Printstring1("""REPEAT"" will draw lines until ""STOP"".") Newline1 Printstring1("""SINGLE"" will draw one line.") Newline1 Printstring1("""STOP"" allows menu selection or further line drawing.") Newline1; Newline1 Display Info(" Fix end of line.") Mouse Info("FIX","FIX","ABORT") Show Cursor1(Status,Marker) %cycle %if Status = right %start Clear Mouse Info -> Abort1 %finish Display Info("Draw line.") Mouse Info("REPEAT","SINGLE","STOP") %cycle {Move to initial grid} Move Abs(Marker_X,Marker_Y) {point.} Show A Line Cursor(Stop,Marker,Cursor) %exit %if Stop = right Enable All Planes Move Abs(Cursor_X,Cursor_Y) Set Colour(Curr Colour) Line Abs(Marker_X,Marker_Y) Store Line(Marker,Cursor,Curr Colour) Marker = Cursor %repeat %until Stop =centre Enable All Planes Display Info("Select Menu item or fix new end point.") Mouse Info("Fix","Fix","Abort") Next Routine(routine,Status,Marker) %if In DW(Marker) %then %c Set to Grid Point(Marker) %repeat %until routine # Current Enable All Planes Clear Info Clear Mouse Info Select Option(routine) Abort1: %end !----------------------------------------------------------------- %routine Draw Box %record(PointFM) TR Corner, Cursor,Marker %byte In area %integer Stop, TR fixed= no, routine=0,Status %label Abort1 Display Main menu Printstring1("First fix one corner of box and then draw rest of box.") Newline1; newline1 Retry: Display Info("Fix corner of Box.") Mouse Info("FIX","FIX","ABORT") Show Cursor1(Status,Marker) %cycle write1(Status,5); newline2 %if Status = right %start Clear Mouse Info -> Abort1 %finish Display Info("Fix Box Size") Show A Box Cursor(Status,Marker,TR Corner) %if Status = right %start Clear Cursor -> Abort1 %finish Set Colour(8) {Show Box in new posn} Box1(Marker_X,Marker_Y,TR Corner_X,TR Corner_Y) Enable All Planes Display Info("Box OK ?") Confirm(TR fixed) Disable RBG Planes {Whether OK or not clear} Set Colour(0) {Cursor plane.} Box1(Marker_X,Marker_Y,TR Corner_X,TR Corner_Y) Set Colour(8) Enable All Planes Clear Info Clear Mouse Info %if Status = right %start -> Abort1 %finish %if TR fixed = no %then -> Retry Enable All Planes Set Colour(Curr Colour) Box1(Marker_X,Marker_Y,TR Corner_X,TR Corner_Y) Disable RBG Planes Clear Cursor Enable All Planes Store Box(Marker,TR Corner,Curr Colour) Display Info("Select Menu item or fix new corner.") Mouse Info("FIX","FIX","ABORT") Next routine(routine,Status,Marker) %if In DW(Marker) %then %c Set to Grid Point(Marker) %repeat %until routine # Current Enable All Planes Select Option(routine) Abort1: %end !------------------------------------------------------------------------ %routine Print Text %integer Status, routine, Offset %record(PointFM) Cursor,TR %string(80) ptext %label Abort Display main menu Retry: %cycle Clear Cursor Display Info("Enter Text.") Clear Mouse Info Read from Terminal(ptext) Set Char Size(Curr Char Size) Set Colour(Curr Colour) Set Char Font(Curr Char Font) Set Char Rot (Curr Char Rot) Display Info("Calculating size.") TR_X = Text length(ptext) {TR contains Ht and length of} TR_Y = Int((5/3) * Curr Char Size) {text initially.} %if TR_X > DWXR - DWXL %start Error Message("Text is too long to fit in window.") -> Abort %finish %if TR_Y > DWYT - DWYB %start Error message("Text is too tall to fit in window") -> Abort %finish Prstring("Ht and length"); newline2 write1(TR_Y,5); write1(TR_X,5); newline2 Offset = Int(TR_Y * 0.365) Position Box(Status,Cursor,TR_X,TR_Y - Offset) %if Status = right %start -> Abort %finish Move Abs(Cursor_X,Cursor_Y) Text(ptext) Cursor_Y = Cursor_Y - Offset TR_X = Cursor_X + TR_X TR_Y = Cursor_Y + TR_Y Prstring("Cursor_Y and TR_Y"); newline2 write1(Cursor_Y,5); write1(TR_Y,5); newline2 Store Text(Cursor,TR,ptext,Curr Char Size,Curr Char Font,Curr Colour) Display Info("Select Menu Item or repeat.") Mouse Info(" "," ","ABORT") Next routine(routine,Status,Cursor) %if Status = right %start Clear Mouse Info -> Abort %finish %if In DW(Cursor) %then %c Set to Grid Point(Cursor) %repeat %until routine # Current Clear Cursor Select Option(routine) Abort: Clear Mouse Info %end %routine Draw Circle %record(PointFM) Cursor,Marker %integer Stop, OK, routine,Status, Radius %label Abort1 Display main menu Prstring("Draw Circle called"); newline2 %if Current symbol_circles_next == Nil %then %c Prstring("CS_C_next == Nil") %else %c Prstring("CS_C_next ## Nil") newline2 Retry: Display Info("Fix Centre of Circle.") Mouse Info("FIX","FIX","ABORT") Show Cursor1(Status,Marker) %cycle write1(Status,5); newline2 %if Status = right %start Clear Mouse Info -> Abort1 %finish Display Info("Fix Circle Size.") Show A Circle Cursor(Status,Radius,Marker,Cursor) %if Status = right %start Clear Cursor Clear Mouse Info -> Abort1 %finish Set Colour(8) {Show Circle in new posn} NCircle(Marker_X,Marker_Y,Radius) Enable All Planes Display Info("Circle OK ?") Confirm(OK) Disable RBG Planes {Whether OK or not clear} Clear Cursor {Cursor plane.} Enable All Planes %if OK = no %then -> Retry Clear Info Clear Mouse Info Set Colour(Curr Colour) Move Abs(Marker_X,Marker_Y) Circle(Radius) Store Circle(Marker_X,Marker_Y,Radius,Curr Colour) Display Info("Select Menu item or fix new centre.") Mouse Info("FIX","FIX","ABORT") Next routine(routine,Status,Marker) %if In DW(Marker) %then %c Set to Grid Point(Marker) %repeat %until routine # Current Enable All Planes Select Option(routine) Abort1: %end !-------------------------------------------------------------- %routine Delete line %integer Status, routine %record(PointFM) Cursor,Marker %record(Line Item) %name Pntr,Last, Next %label Abort Prstring("Delete line called"); newline2 %if %not Current Symbol_lines_next == Nil %start Display Info("Choose Line to be deleted.") Mouse Info("FIX","FIX","ABORT") Show Cursor2(Status,Cursor) %cycle %if Status = right %start Clear Mouse Info -> Abort %finish Pntr == Choose Line(Cursor) %if Pntr == Nil %start Clear Cursor Error Message("No line found.") %finish %else %start Disable RBG Planes {Clear line from cursor plane.} Set Colour(0) Move Abs(Pntr_oriX,Pntr_oriY) Line Abs(Pntr_endX,Pntr_endY) Enable All Planes {Clear line from} Line Abs(Pntr_oriX,Pntr_oriY) {screen.} Set Colour(Curr Colour) %if %not Pntr_next == Nil %start {Remove from line list.} Next == Pntr_next Last == Pntr_last Next_last == Last Last_next == Next %finish %else %start {+/- 1 added to Redraw Area} Pntr_last_next == Nil {parameters to aid detection} %finish {of Pntrs under vertical and} %if Pntr_oriX < Pntr_endX %start {parallel lines.} Redraw Area(Pntr_oriX-1,Pntr_endY-1, Pntr_endX+1,Pntr_oriY+1,0,0, Current Symbol_length,Current Symbol_Ht) Redraw Grid(Pntr_oriX-1,Pntr_endX-1) %finish %else %start Redraw Area(Pntr_endX-1,Pntr_endY-1, Pntr_oriX+1,Pntr_oriY+1,0,0, Current Symbol_length,Current Symbol_Ht) Redraw Grid(Pntr_endX-1,Pntr_endY-1) %finish Dispose(Pntr) %finish %if %not Current Symbol_lines_next == Nil %start Display Info("Select Menu Item or choose new line.") Mouse Info("CHOOSE","CHOOSE","ABORT") Next routine(routine,Status,Cursor) %finish %else %start Clear Mouse Info -> Abort %finish %repeat %until routine # Current Select Option(routine) %finish Abort: %end %routine Delete Box %integer Status, routine %label Abort %record(PointFM) Cursor,Marker %record(Box Item) %name Pntr %if %not Current Symbol_boxes_next == Nil %start Display Info("Choose box to be deleted.") Mouse Info("FIX","FIX","ABORT") Show Cursor2(Status,Cursor) %cycle %if Status = right %start Clear Mouse Info -> Abort %finish Pntr == Choose Box(Cursor) %if Pntr == Nil %start Error Message("No Box found.") Clear Cursor %finish %else %start Set Colour(0) Enable All Planes Box1(Pntr_oriX,Pntr_oriY,Pntr_endX,Pntr_endY) %if %not Pntr_next == Nil %start Pntr_last_next == Pntr_next Pntr_next_last == Pntr_last %finish %else %start Pntr_last_next == Nil %finish Redraw Box Area(Pntr_oriX,Pntr_oriY, Pntr_endX,Pntr_endY) Dispose(Pntr) %finish %if %not Current Symbol_boxes_next == Nil %start Display Info("Select Menu Item or choose new box.") Mouse Info("CHOOSE","CHOOSE","ABORT") Next Routine(routine,Status,Cursor) %finish %else %start Clear Mouse Info -> Abort %finish %repeat %until routine # Current Select Option(routine) %finish Abort: %end %routine Move Box %byte Found Item = no %integer Status, routine,lngth,Ht, Correct, XL,XR,YB,YT %record(PointFM) Marker,Cursor,TR %record(Box Item) %name Pntr %label Abort %if %not Current Symbol_boxes_next == Nil %start Display Info("Choose Box to be moved.") Mouse Info("CHOOSE","CHOOSE","ABORT") Show Cursor2(Status,Cursor) %cycle %if Status = right %start Clear Mouse Info -> Abort %finish Pntr == Choose Box(Cursor) %if Pntr == Nil %start Clear Cursor Error Message("No Box found.") %finish %else %start Set Colour(0) Enable All Planes Box1(Pntr_oriX,Pntr_oriY,Pntr_endX,Pntr_endY) Lngth = Pntr_endX - Pntr_oriX Ht = Pntr_endY - Pntr_oriY XL = Pntr_oriX YB = Pntr_oriY XR = Pntr_endX YT = Pntr_endY Pntr_oriX = DWXR {Set box coordinates off} Pntr_oriY = DWYT {drawing area so not Redraw.} Pntr_endX = DWXR Pntr_endY = DWYT Redraw Box Area(XL,YB,XR,YT) Position Box(Status,Cursor,Lngth,Ht) %if Status = right %start {Abort.} TR_X = Cursor_X + lngth TR_Y = Cursor_Y + Ht Disable RBG Planes Box1(Cursor_X,Cursor_Y,TR_X,TR_Y) Pntr_oriX = XL {Set box coords} Pntr_oriY = YB {back to old values} Pntr_endX = XR Pntr_endY = YT Enable All Planes Set Colour(Pntr_colour) {Redraw box in} Box1(XL,YB,XR,YT) {original place.} -> Abort %finish TR_X = Cursor_X + Lngth TR_Y = Cursor_Y + Ht Set Colour(Pntr_Colour) {Draw actual box.} Box1(Cursor_X,Cursor_Y,TR_X,TR_Y) Set Colour(Curr Colour) Pntr_oriX = Cursor_X Pntr_oriY = Cursor_Y {Update data structure.} Pntr_endX = TR_X Pntr_endY = TR_Y %finish Display Info("Select Menu Item or choose new box.") Mouse Info("CHOOSE","CHOOSE","ABORT") Next Routine(routine,Status,Cursor) %if In DW(Cursor) %then %c Set to Grid Point(Cursor) %repeat %until routine # Current Select Option(routine) %finish Abort: %end %routine Copy Box %byte Found Item = no %integer Status,routine,lngth,Ht, Correct %record(PointFM) Marker,Cursor,TR %record(Box Item) %name Pntr %label Abort %if %not Current Symbol_boxes_next == Nil %start Display Info("Choose Box to be copied.") Mouse Info("CHOOSE","CHOOSE","ABORT") Show Cursor2(Status,Cursor) %cycle %if Status = right %start -> Abort %finish Pntr == Choose Box(Cursor) %if Pntr == Nil %start Clear Cursor Error Message("No Box found.") %finish %else %start Lngth = Pntr_endX - Pntr_oriX Ht = Pntr_endY - Pntr_oriY Enable All Planes Position Box(Status,Cursor,Lngth,Ht) %if Status = right %start {ABORT.} Clear Cursor Enable All Planes -> Abort %finish TR_X = Cursor_X + lngth TR_Y = Cursor_Y + Ht Set Colour(Pntr_Colour) {Draw Box in new} Box1(Cursor_X,Cursor_Y,TR_X,TR_Y) {posn.} Set Colour(Curr Colour) Store Box(Cursor,TR,Pntr_Colour) %finish Display Info("Select Menu Item or choose new box.") Mouse Info("CHOOSE","CHOOSE","ABORT") Next routine(routine,Status,Cursor) %if In DW(Cursor) %then %c Set to Grid Point(Cursor) %repeat %until routine # Current Select Option(routine) %finish Abort: %end %routine Delete Text %byte Found Item = no %integer Status,Text Length=0, Top, routine %record(PointFM) Marker,Cursor, BL, TR %record(Text Item) %name Pntr,Last, Next %label Abort Prstring("Delete Text called"); newline2 %if %not Current Symbol_text_next == Nil %start Display Info("Choose text to be deleted.") Mouse Info("FIX","FIX","ABORT") Show Cursor2(Status,Cursor) %cycle %if Status = right %start -> Abort %finish Pntr == Choose Text(Cursor) %if Pntr == Nil %start Clear Cursor Error Message("No Text found.") %finish %else %start Text Length = Pntr_endX - Pntr_oriX Enable All Planes BL_X = Pntr_oriX; BL_Y = Pntr_oriY TR_X = Pntr_endX; TR_Y = Pntr_endY Clear Window Area(Pntr_oriX,Pntr_oriY,Pntr_endX,Pntr_endY) %if %not Pntr_next == Nil %start Next == Pntr_next Last == Pntr_last Next_last == Last Last_next == Next %finish %else %start Pntr_last_next == Nil %finish Top = Pntr_endY - Pntr_oriY Redraw Area(BL_X,BL_Y,TR_X,TR_Y,0,0, Current Symbol_length,Current Symbol_Ht) Redraw Grid(BL_X,BL_Y) Dispose(Pntr) %finish %if %not Current Symbol_text_next == Nil %start Display Info("Select Menu Item or choose text.") Mouse Info("CHOOSE","CHOOSE","ABORT") Next Routine(routine,Status,Cursor) %finish %else %start -> Abort %finish %repeat %until routine # Current Select Option(routine) %finish Abort: %end %routine Move Text %integer Status,routine,Lngth,Ht,Offset, Correct, oriX,oriY,endX,endY, %record(PointFM) Marker,Cursor,TR %record(Text Item) %name Pntr %label Abort %if %not Current Symbol_text_next == Nil %start Display Info("Choose text to be moved") Mouse Info("CHOOSE","CHOOSE","ABORT") Show Cursor2(Status,Cursor) %cycle %if Status = right %start -> Abort %finish Pntr == Choose Text(Cursor) %if Pntr == Nil %start Clear Cursor Error Message("No Text found") %finish %else %start Lngth = Pntr_endX - Pntr_oriX Ht = Pntr_endY - Pntr_oriY Offset = Int(Ht * 0.365) oriX = Pntr_oriX oriY = Pntr_oriY endX = Pntr_endX endY = Pntr_endY Disable rbg planes Set colour(8) Box1(oriX,oriY,endX,endY) Enable all planes Clear Window Area(Pntr_oriX,Pntr_oriY,Pntr_endX,Pntr_endY) Pntr_oriX = DWXR Pntr_oriY = DWYT {Prevents redrawing.} Pntr_endX = DWXR +10 Pntr_endY = DWYT + 10 Redraw Area(oriX,oriY,endX,endY,0,0, Current Symbol_length,Current Symbol_Ht) Redraw Grid(oriX,oriY) Position Box(Status,Cursor,Lngth,Ht - Offset) %if Status = right %start {ABORT.} Pntr_oriX = oriX Pntr_oriY = oriY Pntr_endY = endY Pntr_endX = endX Set Char Font(Pntr_font) Set Char Size(Pntr_size) ! Set Char Rot (Pntr_rot) Set Colour(Pntr_colour) Move Abs(Pntr_oriX,Pntr_oriY + Offset) {Redraw text in} Text(Pntr_text) {original position.} Set Char Size(Curr Char Size) Set Char Rot (Curr Char Rot) Set Colour(Curr Colour) -> Abort %finish Disable RBG Planes Enable All Planes Set Colour(Pntr_colour) Set Char Size(Pntr_size) Set Char Font(Pntr_font) ! Set Char Rot (Pntr_rot) Move Abs(Cursor_X,Cursor_Y ) Text(Pntr_text) {New text position.} Set Char font(0) Set Char Size(Curr Char Size) Set Colour(Lime) Cursor_Y = Cursor_Y - Offset Pntr_oriX = Cursor_X; Pntr_oriY = Cursor_Y Pntr_endX = Cursor_X + Lngth Pntr_endY = Cursor_Y + Ht %finish Display Info("Select Menu Item or choose text.") Mouse Info("CHOOSE","CHOOSE","ABORT") Next routine(routine,Status,Cursor) %if In DW(Cursor) %then %c Set to Grid Point(Cursor) %repeat %until routine # Current Select Option(routine) %finish %else %start %finish Abort: %end %routine Copy Text %byte In Area %integer Status,routine,Ht,Lngth, Correct, Offset %record(PointFM) Marker,Cursor,TR %record(Text Item) %name Pntr,New1 %if %not Current Symbol_text_next == Nil %start Display Info("Choose text to be copied.") Mouse Info("CHOOSE","CHOOSE","ABORT") Show Cursor2(Status,Cursor) %cycle %if Status = right %start %return %finish Pntr == Choose Text(Cursor) %if Pntr == Nil %start Clear Cursor Error Message("No Text found.") %finish %else %start Lngth = Pntr_endX - Pntr_oriX Ht = Pntr_endY - Pntr_oriY Offset = Int(0.365 * Ht) Position Box(Status,Cursor,Lngth,Ht - Offset) %if Status = right %start Clear Info; Clear Mouse Info %return %finish Enable All Planes Set Colour(Pntr_colour) Set Char Size(Pntr_size) Set Char Font(Pntr_font) ! Set Char Rot (Pntr_rot) Move Abs(Cursor_X,Cursor_Y) Text(Pntr_text) Set Char Font(0) Set Char Size(Curr Char Size) Set Colour(Lime) Cursor_Y = Cursor_Y - Offset TR_X = Cursor_X + Lngth TR_Y = Cursor_Y + Ht Store Text(Cursor,TR,Pntr_text,Pntr_size, Pntr_font,Pntr_colour) %finish Display Info("Select Menu Item or choose text.") Mouse Info("CHOOSE","CHOOSE","ABORT") Next routine(routine,Status,Cursor) %if In DW(Cursor) %then %c Set to Grid Point(Cursor) %repeat %until routine # current Select Option(routine) %finish %end %routine Delete Circle %integer Status, routine %label Abort %record(PointFM) Cursor,Marker %record(Circle Item) %name Pntr %if %not Current Symbol_Circles_next == Nil %start Display Info("Choose Circle to be deleted.") Mouse Info("CHOOSE","CHOOSE","ABORT") Show Cursor2(Status,Cursor) %cycle %if Status = right %start -> Abort %finish Pntr == Choose Circle(Cursor) %if Pntr == Nil %start Error Message("No Circle found") Clear Cursor %finish %else %start Set Colour(0) Enable All Planes Move abs(Pntr_oriX,Pntr_oriY) Circle(Pntr_radius) %if %not Pntr_next == Nil %start Pntr_last_next == Pntr_next Pntr_next_last == Pntr_last %finish %else %start Pntr_last_next == Nil %finish Redraw Area(Pntr_oriX-Pntr_radius,Pntr_oriY-Pntr_radius, Pntr_oriX+Pntr_radius,Pntr_oriY+Pntr_radius, 0,0,Current Symbol_length,Current Symbol_Ht) Redraw Grid(Pntr_oriX-Pntr_radius,Pntr_oriY-Pntr_radius) Dispose(Pntr) %finish %if %not Current Symbol_Circles_next == Nil %start Display Info("Select Menu Item or choose new circle.") Mouse Info("CHOOSE","CHOOSE","ABORT") Next Routine(routine,Status,Cursor) %finish %else %start Clear Mouse Info -> Abort %finish %repeat %until routine # Current Select Option(routine) %finish Abort: %end %routine Move Circle %byte Found Item = no %integer Status, routine, Correct, oX, oY, XL, YB, XR, YT %record(PointFM) Marker,Cursor %record(Circle Item) %name Pntr %label Abort %if %not Current Symbol_circles_next == Nil %start Display Info("Choose circle to be moved.") Mouse Info("CHOOSE","CHOOSE","ABORT") Show Cursor2(Status,Cursor) %cycle %if Status = right %start -> Abort %finish Pntr == Choose Circle(Cursor) %if Pntr == Nil %start Clear Cursor Error Message("No Circle found") %finish %else %start Enable All Planes Set Colour(0) Move Abs(Pntr_oriX,Pntr_oriY) Circle(Pntr_radius) oX = Pntr_oriX; oY = Pntr_oriY XL = Pntr_oriX - Pntr_radius YB = Pntr_oriY - Pntr_radius XR = Pntr_oriX + Pntr_radius YT = Pntr_oriY + Pntr_radius Pntr_oriX = DWXR + Pntr_radius {Set Circle coordinates off} Pntr_oriY = DWYT + Pntr_radius {drawing area so not Redraw.} Redraw Area(XL,YB,XR,YT,0,0, Current Symbol_length,Current Symbol_Ht) Redraw Grid(XL,YB) Position Circle(Status,Pntr_radius,Cursor) %if Status = right %start Pntr_oriX = oX {Set Circle coords} Pntr_oriY = oY {back to old values} Enable All Planes Set Colour(Pntr_colour) {Redraw Circle in} Move Abs(oX,oY) Circle(Pntr_radius) {original place.} -> Abort %finish Set Colour(Pntr_Colour) {Draw actual Circle.} Move Abs(Cursor_X,Cursor_Y) Circle(Pntr_radius) Set Colour(Curr Colour) Pntr_oriX = Cursor_X Pntr_oriY = Cursor_Y {Update data structure.} %finish Display Info("Select Menu Item or choose new circle.") Mouse Info("CHOOSE","CHOOSE","ABORT") Next Routine(routine,Status,Cursor) %if In DW(Cursor) %then %c Set to Grid Point(Cursor) %repeat %until routine # Current Select Option(routine) %finish Abort: %end %routine Copy Circle %byte Found Item = no %integer Status,routine, Correct oX, oY %record(PointFM) Marker,Cursor %record(Circle Item) %name Pntr %label Abort %if %not Current Symbol_Circles_next == Nil %start Display Info("Choose circle to be copied.") Mouse Info("CHOOSE","CHOOSE","ABORT") Show Cursor2(Status,Cursor) %cycle %if Status = right %start -> Abort %finish Pntr == Choose Circle(Cursor) %if Pntr == Nil %start Clear Cursor Error Message("No Circle found") %finish %else %start Enable All Planes Position Circle(Status,Pntr_radius,Cursor) %if Status = right %start {ABORT.} Clear Cursor Enable All Planes -> Abort %finish Set Colour(Pntr_Colour) {Draw Circle in new} Move Abs(Cursor_X,Cursor_Y) {posn.} Circle(Pntr_radius) Set Colour(Curr Colour) Store Circle(Cursor_X,Cursor_Y,Pntr_radius,Pntr_Colour) %finish Display Info("Select Menu Item or choose new circle.") Mouse Info("CHOOSE","CHOOSE","ABORT") Next routine(routine,Status,Cursor) %if In DW(Cursor) %then %c Set to Grid Point(Cursor) %repeat %until routine # Current Select Option(routine) %finish Abort: %end %routine Delete Sym Inst %integer Status, routine %label Abort %record(PointFM) Cursor,Marker, BL,TR %record(Symbol Instance) %name Pntr %record(Symbol) %name Last CS %if %not Current Symbol_Symbols_next == Nil %start Display Info("Choose symbol instance to be deleted.") Mouse Info("CHOOSE","CHOOSE","ABORT") Show Cursor2(Status,Cursor) %cycle %if Status = right %start -> Abort %finish Pntr == Choose Symbol Instance(0,0,Cursor) %if Pntr == Nil %start Error Message("No Symbol found") Clear Cursor %finish %else %start BL_X = Pntr_oriX; BL_Y = Pntr_oriY TR_X = Pntr_endX; TR_Y = Pntr_endY Clear Window Area(Pntr_oriX,Pntr_oriY,Pntr_endX,Pntr_endY) Last CS == Current Symbol Current symbol == Pntr_table entry Change Instance Count(Down) Current symbol == Last CS Pntr_last_next == Pntr_next %if Pntr_next ## Nil %then %c Pntr_next_last == Pntr_last Pntr_next == Nil Pntr_last == Nil Dispose(Pntr) Redraw Area(BL_X,BL_Y,TR_X,TR_Y,0,0, Current Symbol_length,Current Symbol_Ht) Redraw Grid(BL_X,BL_Y) %finish %if %not Current Symbol_Symbols_next == Nil %start Display Info("Select Menu Item or choose symbol instance.") Mouse Info("CHOOSE","CHOOSE","ABORT") Next Routine(routine,Status,Cursor) %finish %else %start Clear Mouse Info -> Abort %finish %repeat %until routine # Current Select Option(routine) %finish Abort: %end %routine Move Symbol %integer Status,routine,Correct,XL,YB,XR,YT %record(PointFM) Cursor,TR, BL %record(Symbol Instance) %name Pntr %record(Symbol) %name ST Pntr, Last CS %label Abort %if %not Current Symbol_Symbols_next == Nil %start Display Info("Select Symbol-Instance to be moved.") Mouse Info("CHOOSE","CHOOSE","ABORT") Show Cursor2(Status,Cursor) %cycle %if Status = right %start -> Abort %finish Pntr == Choose Symbol Instance(0,0,Cursor) %if Pntr == Nil %start Clear Cursor Error Message("No Symbol found.") %finish %else %start XL = Pntr_oriX; XR = Pntr_endX YB = Pntr_oriY; YT = Pntr_endY Clear Window Area(Pntr_oriX,Pntr_oriY,Pntr_endX,Pntr_endY) Pntr_oriX = DWXR +1; Pntr_oriY = DWYT +1 {Prevent redrawing} Pntr_endX = DWXR + 10; Pntr_endY = DWYT +10 Redraw Area(XL,YB,XR,YT,0,0, Current Symbol_length,Current Symbol_Ht) Redraw Grid(XL,YB) ST Pntr == Pntr_table entry TR_X = XR - XL TR_Y = YT - YB Symbol to New Position(Status,BL,TR) %if Status = right %start Last CS == Current Symbol Current Symbol == ST Pntr Redraw Symbol(XL,YB,XR,YT) Pntr_oriX = XL; Pntr_oriY = YB Pntr_endX = XR; Pntr_endY = YT Current Symbol == Last CS -> Abort %finish Pntr_oriX = BL_X; Pntr_oriY = BL_Y Pntr_endX = TR_X; Pntr_endY = TR_Y Last CS == Current Symbol Current Symbol == ST Pntr Redraw Symbol(BL_X,BL_Y,TR_X,TR_Y) Current Symbol == Last CS %finish Display Info("Select Menu Item or choose Symbol-instance.") Mouse Info("CHOOSE","CHOOSE","ABORT") Next routine(routine,Status,Cursor) %if In DW(Cursor) %then %c Set to Grid Point(Cursor) %repeat %until routine # Current Select Option(routine) %finish Abort: %end %routine Copy Symbol(%byte Instance) %byte Found Item = no %integer Status,routine,lngth,Ht, Correct %record(PointFM) Cursor,TR, BL %record(Symbol Instance) %name Pntr %record(Symbol) %name ST Pntr, Last CS %label Abort Prstring("Copy symbol called"); newline2 Prstring("Instance= "); write1(instance,5); newline2 Prstring("Current Symbol= ".Current symbol_name); newline2 %if Instance = yes %start %if Current Symbol_Symbols_next == Nil %start Prstring("No symbols to copy"); newline2 Display Main menu -> Abort %finish Retry: Display Info("Select Symbol-Instance to be copied.") Mouse Info("CHOOSE","CHOOSE","ABORT") Show Cursor2(Status,Cursor) %finish %cycle %if Instance = yes %start %if Status = right %start -> Abort %finish Pntr == Choose Symbol Instance(0,0,Cursor) %if Pntr == Nil %start Clear Cursor Error Message("No Symbol found") -> Retry %finish %else %start ST Pntr == Pntr_table entry %if ST Pntr_name = Current Symbol_name %start -> Abort %finish TR_X = Pntr_endX - Pntr_oriX TR_Y = Pntr_endY - Pntr_oriY %finish %finish %else %start ST Pntr == Choose Sym by name(Symbol table) %if ST Pntr == Nil %start Prstring("ST Pntr == Nil"); newline2 Display Main menu -> Abort %finish TR_X = ST Pntr_length TR_Y = ST Pntr_Ht %finish Display Main menu Symbol to New Position(Status,BL,TR) %if Status = right %start -> Abort %finish Last CS == Current Symbol Current Symbol == ST Pntr Redraw Symbol(BL_X,BL_Y,TR_X,TR_Y) Change Instance Count(Up) Current Symbol == Last CS Pntr == Store Symbol Instance(BL_X,BL_Y,TR_X,TR_Y) Pntr_table entry == ST Pntr %if Instance = yes %start Display Info("Select Menu Item or choose Symbol-Instance.") Mouse Info("CHOOSE","CHOOSE","ABORT") Next routine(routine,Status,Cursor) %if In DW(Cursor) %then %c Set to Grid Point(Cursor) %finish %else routine = Current +1 %repeat %until routine # Current %if Instance = yes %then Select Option(routine) Abort: %end %routine Draw Routine %constbyte Line=1, Box=2, Text=3, Circle=4, Symbol=5 %integer Status %record(PointFM) Point %byte Item, Aborted = no %label Abort %own %string(10) %array Copy Menu(1:12) = "LINE","BOX","TEXT","CIRCLE", "SYM INST","*","*","*", "*","*","*","*" Prstring("Draw routine called"); newline2 Display Menu(Copy Menu) Display Info("Select second menu item.") Mouse Info("ITEM","ITEM","ABORT") Screen Cursor(Status,Point) %if Status = right %start Display Main Menu -> Abort %finish Item = Menu Item(Point) Prstring("Item= "); write1(item,5); newline2 %if Item = Line %then Draw Line %else %c %if Item = Box %then Draw Box %else %c %if Item = Text %then Print Text %else %c %if Item = Circle %then Draw Circle %else %c %if Item = Symbol %then Copy Symbol(no) %c %else Display Main Menu {"no" means not copying an} Abort: {instance.} %end %routine Delete Routine %constbyte Line=1, Box=2, Text=3, Circle=4, Sym Inst=5, Area=6, Symbol=7, Page=8 %integer Status %record(PointFM) Point %byte Item, Aborted = no %label Abort %own %string(10) %array Delete Menu(1:12) = "LINE","BOX","TEXT","CIRCLE", "SYM INST","AREA","SYMBOL", "PAGE","*","*","*","*" Display Menu(Delete Menu) Display Info("Select second menu item.") Mouse Info("ITEM","ITEM","ABORT") Screen Cursor(Status,Point) %if Status = right %start Display Main Menu -> Abort %finish Item = Menu Item(Point) %if Item # Symbol %and Item # Page %then %c Display Main menu %if Item = Line %then Delete Line %else %c %if Item = Box %then Delete Box %else %c %if Item = Text %then Delete Text %else %c %if Item = Circle %then Delete Circle %else %c %if Item = Sym Inst %then Delete Sym Inst %else %c %if Item = Area %then Delete Area %else %c %if Item = Symbol %then Delete Item in(Symbol Table) %else %c %if Item = Page %then Delete Item in(Page table) %c %else Display Main menu Abort: %end %routine Move Routine %constbyte Box=2, Text=3, Circle=4, Symbol=5 %integer Status %record(pointFM) Point %byte Item, Aborted = no %label Abort %own %string(10) %array Move Menu(1:12) = "*","BOX","TEXT","CIRCLE", "SYM INST","*","*","*","*","*", "*","*" Display Menu(Move Menu) Display Info("Select second menu item.") Mouse Info("ITEM","ITEM","ABORT") Screen Cursor(Status,Point) Display Main menu %if Status = right %then -> Abort Item = Menu Item(Point) %if Item = Box %then Move Box %else %c %if Item = Text %then Move Text %else %c %if Item = Circle %then Move Circle %else %c %if Item = Symbol %then Move Symbol %c %else Display Main menu Abort: %end %routine Copy Routine %constbyte Box=2, Text=3, Circle=4, SymInst=5, Page=6 %integer Status %record(PointFM) Point %byte Item, Aborted = no %label Abort %own %string(10) %array Copy Menu(1:12) = "*","BOX","TEXT","CIRCLE", "SYM INST","*","*", "*","*","*","*","*" Display Menu(Copy Menu) Display Info("Select second menu item.") Mouse Info("ITEM","ITEM","ABORT") Screen Cursor(Status,Point) Display Main menu %if Status = right %then -> Abort Item = Menu Item(Point) %if Item = Box %then Copy Box %else %c %if Item = Text %then Copy Text %else %c %if Item = Circle %then Copy Circle %else %c %if Item = SymInst %then Copy Symbol(yes) %c %else Display Main menu Abort: {"yes" indicates copying an instance"} %end !--------------------------------------------------------------- %routine Zoom Routine %constbyte Life=1, Max=4 %record %format Area(%integer XL,YB,XR,YT,%byte Zoom type) %own %record(area) %array Zoom Depth(1:20) %integer Status, Item %record(PointFM) Cursor %own %string(10) %array Zoom Menu(1:12) = "*","*","*","LIFE SIZE", "MAX SIZE", "PREV AREA", "PAGE","*","*","*","*","*" %Routine Life Size %record(PointFM) BL, TR %integer W Ht,W Length %if Depth <= 20 %start Retry: Define Area(BL,TR,Status) %if %not Status = right %start %if TR_X - BL_X > 20 %and %c TR_Y - BL_Y > 20 %start Zoom Depth(Depth)_XL = DWXL Zoom Depth(Depth)_YB = DWYB Zoom Depth(Depth)_XR = DWXR Zoom Depth(Depth)_YT = DWYT Zoom Depth(Depth)_Zoom type = Life Depth = Depth + 1 Clear Drawing Area W Ht = TR_Y - BL_Y W Length = TR_X - BL_X %if W Ht > 675 %start W Ht = 675 {~16.92cm * 40} TR_Y = BL_Y + W Ht %finish %if W Length > 800 %start W Length = 800 {~20.07cm * 40} TR_X = BL_X + W Length %finish Set Window(BL_X,BL_Y,TR_X,TR_Y) Set Lifesize Viewport(BL_X,BL_Y,TR_X,TR_Y) %finish %else %start Error Message("Area too small.") -> Retry %finish %finish %finish %else Error Message("ERROR: Maximum depth reached.") %end %routine Max Size %record(PointFM) TR,BL %if Depth <= 20 %start Retry: Define Area(BL,TR,Status) %if %not Status = right %start %if TR_X - BL_X > 20 %and %c TR_Y - BL_Y > 20 %start Zoom Depth(Depth)_XL = DWXL Zoom Depth(Depth)_YB = DWYB Zoom Depth(Depth)_XR = DWXR Zoom Depth(Depth)_YT = DWYT Zoom Depth(Depth)_Zoom type = Max Depth = Depth + 1 Clear Drawing Area Set Window(BL_X,BL_Y,TR_X,TR_Y) Set Max Viewport(BL_X,BL_Y,TR_X,TR_Y) Redraw Area(BL_X,BL_Y,TR_X,TR_Y,0,0, Current Symbol_length,Current Symbol_Ht) Draw Grid %finish %else %start Error Message("Area too small.") -> Retry %finish %finish %finish %else Error Message("ERROR: Maximum depth reached.") %end %routine Previous Size %if Depth >1 %start Clear Drawing Area Depth = Depth - 1 Set Window(Zoom Depth(Depth)_XL,Zoom Depth(Depth)_YB, Zoom Depth(Depth)_XR,Zoom Depth(Depth)_YT) %if Depth = 1 %start Set Max Viewport(Zoom Depth(1)_XL,Zoom Depth(1)_YB, Zoom Depth(1)_XR,Zoom Depth(1)_YT) %finish %else %if Zoom Depth(Depth-1)_Zoom type = Max %start Set Max Viewport(Zoom Depth(Depth)_XL,Zoom Depth(Depth)_YB, Zoom Depth(Depth)_XR,Zoom Depth(Depth)_YT) %finish %else %start Set Lifesize Viewport(Zoom Depth(Depth)_XL,Zoom Depth(Depth)_YB, Zoom Depth(Depth)_XR,Zoom Depth(Depth)_YT) %finish Redraw Area(Zoom Depth(Depth)_XL,Zoom Depth(Depth)_YB, Zoom Depth(Depth)_XR,Zoom Depth(Depth)_YT,0,0, Current Symbol_length,Current Symbol_Ht) Draw Grid %finish %end %routine Whole Page Depth = 1 Clear Drawing Area Set Window(0,0,Current Symbol_length,Current Symbol_Ht) Set Max Viewport(0,0,Current Symbol_length,Current Symbol_Ht) Redraw Symbol(0,0,Current Symbol_length,Current Symbol_Ht) Draw Grid %end Clear Cursor Display Menu(Zoom Menu) Printstring1("""LIFE SIZE"" shows literal size of area.") newline1 Printstring1("""MAX SIZE"" shows area enlarged to max possible size.") newline1 Printstring1("""PREV AREA"" shows area before current area.") newline1 Printstring1("""PAGE"" displays full page."); newline1 newline1 Display Info("Choose second menu item.") Mouse Info("Choose","Choose","Abort") Screen Cursor(Status,Cursor) Display Main Menu %if Status = right %then -> Abort Item = Menu Item(Cursor) %if Item = 4 %then Life Size %else %c %if Item = 5 %then Max Size %else %c %if Item = 6 %then Previous Size %else %c %if Item = 7 %then Whole Page Abort: %end !--------------------------------------------------------------- %routine PDF Routine %integer Status, Item %record(PointFM) Cursor %own %string(10) %array Pdf Menu(1:12) = "*","*","*","*","*","*","*", "*","*","*","SYMBOL","PAGE" Display Menu(Pdf Menu) Printstring1("Creates a Pseudo Display File from the specified symbol") Printstring1(" or Page."); newline1 Printstring1("Filenames are given a "".PDF"" extension.") newline1; newline1 Mouse Info("Choose","Choose","Abort") Screen Cursor(Status,Cursor) %if Status = right %start Display Main Menu -> Abort %finish Item = Menu Item(Cursor) %if Item = 11 %then Pdf Item in(Symbol Table) %else %c %if Item = 12 %then Pdf Item in(Page Table) %c %else Display Main menu Abort: %end %routine Edit routine %integer Status, Item %record(PointFM) Cursor %own %string(10) %array Edit Menu(1:12) = "*","*","*","*","*","SYMBOL", "NEW SYMBOL","PAGE","NEW PAGE", "*","*","*" Display Menu(Edit Menu) Display Info("Choose Menu Item.") Mouse Info("CHOOSE","CHOOSE","ABORT") Screen Cursor(Status,Cursor) %if Status = right %then -> Abort Item = Menu Item(Cursor) %if Item = 6 %then Edit Item in(Symbol Table) %else %c %if Item = 7 %then New Symbol %else %c %if Item = 8 %then Edit Item in(Page Table) %else %c %if Item = 9 %then New Page Abort: Display Main Menu Clear Info Prstring("Edit routine ended"); newline2 %end %routine Grid Routine %integer Status, Item %record(PointFM) Cursor %string(4) Size %own %string(10) %array Grid Menu(1:12) = "*","*","*","*","SIZE","ON", "OFF","*","*","*","*","*" %routine Change Grid %integer New Interval %on %event 3,4 %start Error Message("Non-numeric value.") Clear Input -> Error %finish Remove Grid Clear Grid Error: Display Info("Enter new grid size. Current Size = ".size) Move To(1,9) Clear Line read(New Interval) Clear Input %if New Interval > 999 %start Error message("Grid size is too large") -> Error %finish %if New interval < 1 %start %if New Interval = 0 %then New Interval = 1 %if New Interval < 0 %start Error Message("ERROR: Positive values only.") -> Error %finish %finish Move To(V200X,V200Y) Grid Interval = New Interval Set Grid Draw Grid Redraw Area(DWXL,DWYB,DWXL+Scale Line Length,DWYT,0,0, Current Symbol_length,Current Symbol_Ht) Redraw Area(DWXL+Scale Line Length,DWYB,DWXR,DWYB+Scale Line length, 0,0,Current Symbol_length,Current Symbol_Ht) %end Size = ItoS (Grid Interval, 0) %if Grid on = yes %start Display Info("Grid is on. Current Size = ".Size) %else Display Info("Grid is off. Current Size = ".Size) %finish Display Menu(Grid Menu) Mouse Info("Choose","Choose","Abort") Screen Cursor(Status,Cursor) Display Main Menu %if Status = right %then -> Abort Item = Menu Item(Cursor) %if Item = 5 %then Change Grid %if Item = 6 %then Grid on = yes %else %c %if Item = 7 %then Grid on = no %c %else Display Main menu Abort: Clear Info %end %routine Duplicate routine %integer Status, Item %record(PointFM) Cursor %own %string(10) %array Duplicate Menu(1:12) = "*","*","*","*","*","*", "*","SYMBOL","PAGE","*", "*","*" Display Menu(Duplicate Menu) Printstring1("Creates a new page or symbol table entry identical to") newline1 Printstring1("the one chosen."); newline1; newline1 Mouse Info("Choose","Choose","Abort") Screen Cursor(Status,Cursor) %if Status = right %start Display Main menu -> Abort %finish Item = Menu Item(Cursor) %if Item = 8 %then Duplicate Item in(Symbol Table) %else %c %if Item = 9 %then Duplicate Item in(Page Table) %c %else Display Main menu Abort: Clear Info %end %routine Read Routine %integer Status, Item %record(PointFM) Cursor %own %string(10) %array Read Menu(1:12) = "*","*","*","*","*","*","*", "*","SYMBOL","PAGE","*","*" Display Menu(Read Menu) Mouse Info("Choose","Choose","Abort") Screen Cursor(Status,Cursor) %if Status = right %start Display Main Menu -> Abort %finish Item = Menu Item(Cursor) %if Item = 9 %then Read Item into(Symbol Table) %else %c %if Item = 10 %then Read Item into(Page Table) %c %else Display Main menu Abort: %end %routine Save Routine %integer Status, Item %record(PointFM) Cursor %own %string(10) %array Save Menu(1:12) = "*","*","*","*","*","*","*", "*","*","SYMBOL","PAGE","*" Display Menu(Save Menu) Printstring1("""SYMBOL"" appends selected symbol to") Printstring1(" specified file"); newline1 Printstring1("""PAGE"" overwrites specified file with specified page.") Newline1; Newline1 Mouse Info("Choose","Choose","Abort") Screen Cursor(Status,Cursor) %if Status = right %start Display Main Menu -> Abort %finish Item = Menu Item(Cursor) %if Item = 10 %then Save Item in(Symbol Table) %else %c %if Item = 11 %then Save Item in(Page Table) %c %else Display Main menu Abort: %end !-------------------------------------------------------------- %routine Quit routine %integer quit Display Info("Do you want to terminate the program ?") Confirm(quit) %if quit = left %then End Program = yes Clear Mouse Info Clear Info %end %routine Select Option(%integer Item) %label End %switch Option(1:16) -> Option(Item) Option(1): Draw Routine -> End Option(2): Delete Routine -> End Option(3): Move Routine -> End Option(4): Copy Routine -> End Option(5): Zoom routine -> End Option(6): Grid Routine -> End Option(7): Edit Routine -> End Option(8): Duplicate Routine -> End Option(9): Read Routine -> End Option(10): Save Routine -> End Option(11): PDF Routine -> End Option(12): Quit Routine -> End Option(13): Change Colour -> End Option(14): Change Char Size -> End Option(15): Change Char Font -> End Option(16): Change Char Rot End: Clear Info %end %routine Draw Screen Prstring("Draw screen called"); newline2 Set Colour(Red) Box2(0,0,687,511) Line(0,461,687,461) Line(139,0,139,461) Line(0,115,139,115) Set Colour(Yellow) Place Word("Information:",10,495) Place Word("M_L:",10,470) Place Word("M_C:",150,470) Place Word("M_R:",290,470) Place Word("COLOUR",10,85) Place Word("TEXT SIZE",10,60) Place Word("TEXT FONT",10,35) Place Word("TEXT ANG.", 10,10) Display Main Menu %end %routine Initialise V200 Clear Screen V200X = 0; V200Y = 12 Move To(V200X,V200Y) %end ! %on %event 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %start ! Move To(1,3) ! Clear Line ! Printstring("Event:") ! write(Event_event,3); write(Event_sub,1) ! Move To(V200X,V200Y) ! %if Event_event = 9 %then Open Input(0,":") ! %if Event_event = 0 %start ! Quit routine ! %if End Program = no %start ! Open Input(0,":") ! Open Output(0,":") ! Store Off ! View On(0) ! Set Colour(Curr Colour) ! Set Char Font(Curr Char Font) ! Set Char Size(Curr Char Size) ! Current Symbol == Current Page ! Display Main Menu ! Clear Drawing Area ! Set window(0,0,Current Symbol_Length,Current Symbol_Ht) ! Set Max Viewport(0,0,Current Symbol_length,Current Symbol_Ht) ! Redraw Symbol(0,0,Current Symbol_length,Current Symbol_Ht) ! Draw Grid ! %finish ! %finish ! -> Terminate Program ! %finish ! BEGIN PROGRAM. Diag On = no DWXL = 0; DWXR = 547; DWYB = 0; DWYT = 460 VPXL = 140; VPXR = 687; VPYB = 0; VPYT = 460 initialise for(default device) Set terminal mode(No page) Set Shade Mode(Outline) Set Chord Step(5) Set Char Font(0) Read Font Curr Colour = Black Set Colour(Curr Colour) Set Char Quality(Software Text) Curr Char Size = 40 Set Char size(Curr Char Size) Curr Char Font = 12 Curr Char Rot = 0 newframe Draw Screen Initialise V200 Current Page == Base Page Table Base Page table = 0 Base symbol table = 0 Grid Interval = 20 { 0.5cm interval.} Set Grid Fill(85,85,125,105) Display Text Size(40) Display Text Font(12) Display Text Rot (0) Restart: MouseX = 0; MouseY = 0 Display Info("Edit new page or read in page from file.") %cycle Choose from(start,"Read"," ","New") %repeat %until L or R Pressed(Start) %if start = left %start Read Item into(Page Table) %if Base Page Table_next == Nil %then -> Restart Current Page == Base Page Table_next Current Symbol == Current Page Set Window(0,0,Current Symbol_length,Current Symbol_Ht) Set Max Viewport(0,0,Current Symbol_length,Current Symbol_Ht) Display name of page(Current Symbol_name) Display Page Size(Current Symbol_length) Draw Grid Redraw Symbol(0,0,Current Symbol_length,Current Symbol_Ht) %finish %else New Page Clear Mouse Info Terminate Program: %while end program = no %cycle Menu Selection %repeat Clear Info Clear Mouse Info Disable RBG Planes Clear Cursor terminate edwin Clear Screen Set terminal mode(0) %endofprogram