(*--- FileName : EDGRA3.pas Version : July 24, 1986 made by : JOS Objective: This is the EXTENDED graphics editor. version 3 Last Changes Aug 21, 1986 => expansion of the help feature. Sep 26, 1986 => Addition of the CircleSegment routine. NOTE Active Color = 'E' ---*) program GRAPHICS_EDITOR; {$V-} {V = avoid String Checking in passing parameters} {$I \JOS\JOS-var.pas} (* Variables Used for ED-GRA *) type STRING10 = STRING[10]; var POSI, TOPP1, TNUMBP1, ITM, X, Y, INCX, INCY, I, J, ACTIVE_COLOR, COLOR : integer; HIRES_MODE, SAVE_FILE : boolean; FNAME : STRING8; RESP, CH_MOVE : char; { procedure to re-assign values to the variable NUMB } procedure ASSIGN_VALUES (SYS_NUM, SHEET_NUM, CODE : integer); begin end; {$I \jos\graph.p} {$I \JOS\JOS-UTIL.PAS} {$I \JOS\JOS-UTI2.pas} {$I \JOS\JOS-UTI3.pas} {$I \JOS\JOS-GRA2.PAS} (*--- NOT VERY EFFICIENT ROUTINE IS NOT USED IN THIS FILE !!!!!!! Procedure to fill a square (defined by x1,y1,x2,y2) of the screen with a character number NCHAR. if MODE = 0 is TextMode and CODE = 0 -> fill character byte. CODE = 1 -> fill atribute byte. MODE = 1 is HiRes, coordinates in Hires: 0 <= X <= 639, 0 <= Y <= 199. MODE = 2 is HiRes, coordinates in TextMode: 0 <= X <= 80, 0 <= Y <= 25. ---*) procedure CLR_AREA (X1, Y1, X2, Y2, NCHAR, MODE, CODE : INTEGER); VAR X, Y : INTEGER; begin CASE MODE OF 0 : for Y := Y1 TO Y2 do for X := X1 TO X2 do MEM [$B800:$0 + (Y-1)*160 + (X-1)*2 + CODE] := NCHAR; 1 : for Y := Y1 TO Y2 do if (Y MOD 2) = 0 then for X := (X1 DIV 8) TO (X2 DIV 8) do MEM [$B800:$0 + (Y DIV 2)*80 + X] := NCHAR ELSE for X := (X1 DIV 8) TO (X2 DIV 8) do MEM [$BA00:$0 + (Y DIV 2)*80 + X] := NCHAR; 2 : begin Y1 := (Y1-1)*8; Y2 := (Y2-1)*8 + 7; for Y := Y1 TO Y2 do if (Y MOD 2) = 0 then for X := X1 TO X2 do begin MEM [$B800:$0 + (Y DIV 2)*80 + X-1] := NCHAR; MEM [$BA00:$0 + (Y DIV 2)*80 + X-1] := NCHAR; end; end; end; end; procedure CODE_WRITE; begin rewrite (CODEFILE); for I := 1 to TOP do case COMM[I] of '*', ' ','@','#', 'T' : writeln (CODEFILE, COMM[I], STNG[I]); 'N' : begin write (CODEFILE, COMM[I]); for J := 1 to NPAR do write (CODEFILE, PAR[I,J]:4); J := PAR [I,3]; writeln (CODEFILE, FORMAT[J,1]:4, FORMAT[J,2]:4,' ', NUMB [J]:FORMAT[J,1]:FORMAT[J,2],' ', STNG[i]); end; else begin write (CODEFILE, COMM[I]); for J := 1 to NPAR do write (CODEFILE, PAR[I,J]:4); writeln (CODEFILE, ' ', STNG[i]); end; end; { case } writeln (CODEFILE, 'Q end of file set by EDGRA3'); writeln (TOP:10, 'Lineas written'); close (CODEFILE); end; procedure CODE_LIST; var CH, CH2 : char; LFR, LTO, LE, i, j : integer; procedure LIST; begin ClrScr; gotoxy (20,2); write('This graph has ',TOP:3,' lineas'); gotoxy (10,5); write ('Give starting line :'); gotoxy (10,6); write ('Give ending line :'); LFR := trunc(INPUT_REAL(34,5,LFR, 1, TOP-1, 5,0, CH)); LTO := trunc(INPUT_REAL(34,6,LTO, LFR+1, TOP, 5,0, CH)); gotoxy(1,8); for I := LFR to LTO do begin write (i:3, ' => '); case COMM[I] of '*', ' ','@','#','Q', 'T' : writeln (COMM[I], STNG[I]); 'N' : begin write (COMM[I]); for J := 1 to NPAR do write (PAR[I,J]:4); J := PAR [I,3]; writeln (FORMAT[J,1]:4, FORMAT[J,2]:4,' ', NUMB [J]:FORMAT[J,1]:FORMAT[J,2],' ', STNG[i]); end; else begin write (COMM[I]); for J := 1 to NPAR do write (PAR[I,J]:4); writeln (' ', STNG[i]); end; end; { case } end; writeln; writeln; writeln; end; procedure EDIT_L; begin CLR_LINES(23,25); gotoxy (1,23); write ('EDIT #',LE:4,' => ', COMM [LE]:1,' '); for i := 1 to NPAR do write(PAR [LE,i]:6); I := 1; repeat PAR [LE,i] := trunc(INPUT_REAL(13+6*i,23,PAR[LE,i],0,640,4,0,CH)); i := CURSOR_MOVE (i, 1, NPAR, CH); until ch in [^M, ^[, ^R,^C ]; end; begin ClrScr; gotoxy (20,2); write('This graph has ',TOP:3,' lineas'); LE := 1; CH := ^E; LFR := 1; LTO := TOP; if TOP > 0 then begin repeat if CH in [^A,^E,^R, ^Z,^X,^C] then LIST; gotoxy (1,24); write (' = exit. Enter line # to edit :'); LE := trunc(INPUT_REAL (38,24,LE, 1, TOP, 3, 0, CH)); if CH in [^M,^A,^E,^R, ^Z,^X,^C] then EDIT_L; until CH = ^[; end; end; function STAT(K : integer) : string80; var NUM : array [1..npar] of string10; J : integer; begin if (0 < K) and (K <= TOP) then if COMM [K] in ['A','B','C','D','W','N'] then begin STR (PAR[K,1], NUM[1]); for j := 2 to NPAR do begin STR (PAR[K,J]:2, NUM[J]); NUM[J] := CONCAT (',',NUM[J]); end; CASE COMM[K] OF 'A':STAT:=CONCAT ('ARROW (',NUM[1],NUM[2],NUM[3],NUM[4],');'); 'B':STAT:=CONCAT ('BOX (',NUM[1],NUM[2],NUM[3],NUM[4],');'); 'C':STAT:=CONCAT ('CIRCLE(',NUM[1],NUM[2],NUM[3],');'); 'D':STAT:=CONCAT ('DRAW (',NUM[1],NUM[2],NUM[3],NUM[4],');'); 'W':STAT:=CONCAT ('WRS (',NUM[1],NUM[2],',''', STNG [K],''');'); end; end; end; (*---- Make draws begin ----*) procedure CURSOR (COLOR : integer); begin DRAW (X-5,Y-5, X+5, Y+5, COLOR); DRAW (X-5,Y+5, X+5,Y-5, COLOR); (* DRAW (X-5, Y, X+5, Y, COLOR); DRAW (X, Y-5, X , Y+5, COLOR);*) end; procedure MOVE_CURSOR; begin repeat CH_MOVE := GET_CHAR; case CH_MOVE of 'X' : INCX := INCX + 1; 'x' : INCX := INCX - 1; 'Y' : INCY := INCY + 1; 'y' : INCY := INCY - 1; end; if Upcase (CH_MOVE) in ['X','Y'] then begin gotoxy(16, YTEXT1); write(INCX:2); gotoxy(22,YTEXT1); write(INCY:2); end; until CH_MOVE IN [^A,^E,^R, ^S,^D, ^Z,^X,^C, ' ']; CURSOR (0); CASE CH_MOVE OF ^A, ^E, ^R : Y := Y - INCY; {UP } ^Z, ^X, ^C : Y := Y + INCY; {DOWN } ^S : X := X - INCX; {LEFT } ^D : X := X + INCX; {RIGHT } end; CASE CH_MOVE OF ^A, ^Z : X := X - INCX; {LEFT } ^R, ^C : X := X + INCX; {RIGHT } end; IF X < 0 THEN X := 0; IF X > 639 THEN X := 639; IF Y < 0 THEN Y := 0; IF Y > 199 THEN Y := 199; IF CH_MOVE <> ' ' THEN CURSOR (1); gotoxy (3,YTEXT1);write(X:3); gotoxy(9,YTEXT1); write(Y:3); end; procedure COLOR_BOXES; begin if not HIRES_MODE then begin BOX (280, YTEXT2*8-8,288,YTEXT2*8-1, 1); fillShape (284, YTEXT2*8-4,0,1); BOX (290, YTEXT2*8-8,298,YTEXT2*8-1, 1); fillShape (294, YTEXT2*8-4,1,1); BOX (300, YTEXT2*8-8,308,YTEXT2*8-1, 1); fillShape (304, YTEXT2*8-4,2,1); BOX (310, YTEXT2*8-8,318,YTEXT2*8-1, 1); fillShape (314, YTEXT2*8-4,3,1); end; end; procedure ASK_POSITION; var CH3 : CHAR; ST : STRING80; TMP : REAL; begin repeat if HIRES_MODE then CH3:=SCRIO_CHAR(1,YTEXT1,'=add line, =replace, =cancel') else CH3:=SCRIO_CHAR(1,YTEXT1,'=add, eplace, =Exit'); until CH3 in ['R', 'I', ^M, ^[ ]; case CH3 of 'R' : begin gotoxy(1,YTEXT1); write (' ':39); TMP := SCRIO_REAL (1,YTEXT1,'Replace line #', 0, TOP, 3,0); POSI := TRUNC(TMP); if POSI > 0 then begin ST := STAT (POSI); gotoxy (1,YTEXT1); write ('Replacing..=con.,=Cancel'); gotoxy (1,YTEXT3); write (ST); CH3 := INPUT_CHAR; if CH3 = ^M then begin EXEC (POSI, false); COMM[POSI] := COMM [TOPP1]; STNG [POSI] := STNG [TOPP1]; FOR I := 1 TO NPAR DO PAR[POSI,I] := PAR [TOPP1,I]; end; gotoxy (1,YTEXT3); write (' ':50); end; end; ^M : begin TOP := TOP + 1; { Return } if COMM [TOP] = 'N' then TOP_NUMB := TOP_NUMB + 1; end; ^[ : EXEC (TOPP1, false); { Esc } end {case} end; procedure MAKE (CODE : char; ST_CODE : string10); var LEN1, CP, TAKEN, F1, F2, F3 : integer; EC : char; procedure SECOND_POINT; begin repeat MOVE_CURSOR; EXEC (TOPP1, false); case CODE of 'C', 'S' : PAR[TOPP1,3] := round( SQRT( SQR( PAR[TOPP1,1]-X ) + SQR( PAR[TOPP1,2]-Y ) )); 'A','B','D','G' : begin PAR [TOPP1,3] := X; PAR [TOPP1,4] := Y; end; 'N' : begin PAR [TOPP1,1] := (X div 8)+1; PAR [TOPP1,2] := (Y div 8)+1; gotoxy (LEN1,YTEXT2); write ( PAR[TOPP1,1]:3, ',', PAR[TOPP1,2]:3, ','); end; 'W' : begin PAR [TOPP1,1] := X; PAR [TOPP1,2] := Y; gotoxy (LEN1,YTEXT2); write ( PAR[TOPP1,1]:3, ',', PAR[TOPP1,2]:3, ','); end; end; EXEC (TOPP1,true); until CH_MOVE = ' '; end; begin TOPP1 := TOP + 1; for i := 1 to NPAR do PAR [TOPP1,I] := 0; STNG [TOPP1] := ''; COMM [TOPP1] := CODE; PAR [TOPP1,5] := ACTIVE_COLOR; LEN1 := LENGTH (ST_CODE) + 1; case CODE of 'W' : begin gotoxy (1,YTEXT2); write('String ? '); read (STNG [TOPP1]); write(' Direction ?'); readln (PAR [TOPP1,3]); INCX := 8; INCY := 8; end; 'G' : begin gotoxy (1,YTEXT2); write('Function # ? ');read (STNG [TOPP1]); end; 'S' : begin { Circle Segment } gotoxy (1,YTEXT2); write ('Ang Begin & End :'); readln (PAR [TOPP1,4],PAR [TOPP1,5]); end; 'N' : begin TNUMBP1 := TOP_NUMB + 1; gotoxy (1,YTEXT2); write (' ':40); gotoxy (1,YTEXT3); write('# Pos = -- # Dec = --'); gotoxy (1,YTEXT2); write(' Indx = -- Value = '); CP := 1; TAKEN := 0; F1 := 2; F2 := 0; F3 := 0; NUMB[TNUMBP1] := 0; repeat case CP of 1 : F1 := trunc(INPUT_REAL (8,YTEXT3,F1, 1,40, 3,0,EC)); 2 : F2 := trunc(INPUT_REAL (22,YTEXT3,F2, 0, 9, 3,0,EC)); 3 : F3 := trunc(INPUT_REAL (8,YTEXT2, F3,-99,99, 3,0,EC)); 4 : numb [TNUMBP1] := INPUT_REAL (22,YTEXT2, NUMB[TNUMBP1], -9.9E9, 9.9E9,F1, F2, EC); end; TAKEN := TAKEN or (1 shl (CP-1)); CP := CURSOR_MOVE (CP, 1, 4, EC); until (EC = ^M) and (TAKEN = $0F); CLR_LINES (YTEXT2,YTEXT3); FORMAT [TNUMBP1,1]:=F1; FORMAT [TNUMBP1,2]:=F2; PAR [TOPP1,4] := F3; PAR [TOPP1,3] := TNUMBP1; NUM_IDX [TNUMBP1] := TOPP1; X := (X div 8) * 8; Y := (Y div 8) * 8; INCX := 8; INCY := 8; end; 'F' : begin COLOR_BOXES; gotoxy (1,YTEXT2); write ('FillColor :','Border :':12); PAR [TOPP1,5]:=trunc(INPUT_REAL(12,YTEXT2,ACTIVE_COLOR,0,3,2,0,EC)); PAR [TOPP1,4] := trunc (INPUT_REAL (25,YTEXT2,0,0,3,2,0,ec)); end; end; CLR_LINES(YTEXT2,YTEXT2); gotoxy (1,YTEXT2); write(ST_CODE); CURSOR (1); repeat MOVE_CURSOR; until CH_MOVE = ' '; PAR [TOPP1,1] := X; PAR [TOPP1,2] := Y; case CODE of 'N' : begin { from HIRES to TEXTMODE } PAR [TOPP1,1] := (X div 8)+1; PAR [TOPP1,2] := (Y div 8)+1; end; 'A','B','D','G' : begin PAR [TOPP1,3] := X; PAR [TOPP1,4] := Y; end; end; gotoxy (LEN1,YTEXT2); write ( PAR[TOPP1,1]:3, ',', PAR[TOPP1,2]:3, ','); CURSOR (1); if CODE in ['W','N'] then EXEC (TOPP1, true); if CODE = 'F' then begin CURSOR (0); exec_all (false); EXEC (TOPP1, true) ; end else SECOND_POINT; gotoxy (LEN1 + 8,YTEXT2); write (PAR[TOPP1,3]:3, ',',PAR[TOPP1,4]:3, ')'); ASK_POSITION; end; procedure CHNG_INPUT_AREA; begin if YTEXT1 = 1 then begin CLR_AREA (1,1, 80,3, $0, 2,0); YTEXT1 := 25; YTEXT2 := 24; YTEXT3 := 23; YGRAPH := 180; end else begin CLR_AREA (1,23, 80,25, $0, 2,0); YTEXT1 := 1; YTEXT2 := 2; YTEXT3 := 3; YGRAPH := 20; end; EXEC_ALL (false); end; procedure PROMPED (S : STRING15); begin CLR_LINES (YTEXT1, YTEXT2); draw (0,YGRAPH, 639,YGRAPH,1); gotoxy (1,YTEXT1); write ('X=',X:3,' Y=',Y:3,' Ix=',INCX:2,' IY=',INCY:2,' # S=',TOP:3); gotoxy (1,YTEXT2); write ( S ); end; procedure HELP; var BUFFER : array [1..16287] of byte; procedure HELP_CTRL (PAGE : integer); var CH : char; code : integer; begin repeat clrscr; gotoxy (1,1); write ('Page:', (PAGE-1):3); display_page (PAGE,0,0); gotoxy (1,24); write (' = Exit, (1-5) = Help page #'); CH := GET_CHAR; if CH in ['1'..'5'] then begin Val (CH,page,code); page := page + 1; end; until CH in [^[, ^M]; end; begin if SCR_MODE < 4 then HELP_CTRL (2) else begin if HIRES_MODE then GetPic (BUFFER, 0,0,639, 199) else GetPic (BUFFER, 0,0,319, 199); TextMode; HELP_CTRL (2); if HIRES_MODE then HiRes else GraphColorMode; PutPic (BUFFER, 0,199); end; end; { ========================== } procedure SETP (CODE : char; ST_CODE : string10); var EC : char; begin gotoxy (1,YTEXT2); write (ST_CODE); case CODE of 'C' : begin COLOR_BOXES; ACTIVE_COLOR:=trunc(INPUT_REAL(16,YTEXT2,ACTIVE_COLOR,0,3,2,0,EC)); end; 'P' : begin TOPP1 := TOP + 1; for i := 1 to NPAR do PAR [TOPP1,i] := 0; STNG [TOPP1] := ''; COMM [TOPP1] := 'P'; PAR [TOPP1,1]:=trunc(INPUT_REAL(12,YTEXT2,ACTIVE_COLOR,0,3,2,0,EC)); exec (TOPP1, true); ASK_POSITION; end; '@','#','T' : begin TOP := TOP + 1; for i := 1 to NPAR do PAR [TOP,i] := 0; COMM [TOP] := CODE; read (STNG [TOP] ); end; end; end; procedure EDIT; var SW_EXIT, SW_MODE, SW_CARD : boolean; PROM_STR : STRING15; begin clrscr; if SCRIO_CHAR (30, 12, 'Hires or Graphics mode ? (H/G)') = 'H' then begin HIRES_MODE := true; hires; hirescolor (1); X := 320; end else begin HIRES_MODE := false; graphColorMode; X := 160; end; SW_MODE := false; PROM_STR := 'COMMAND ?'; if SW_CARD then begin fillchar ( mem[$BC00:0], 16384, 0 ); { see NOTE 1 } port [$3D9] := 32; PORT [$3DD] := 32; end; Y := 100; INCX := 8; INCY := 5; SW_EXIT := false; YTEXT1 := 25; YTEXT2 := 24; YTEXT3 := 23; YGRAPH := 180; ACTIVE_COLOR := 1; EXEC_ALL (FALSE); repeat PROMPED ( PROM_STR ); RESP := Upcase (INPUT_CHAR); if SW_MODE and (RESP in ['A'..'Z']) then SAVE_FILE := true; if SW_MODE then CASE RESP OF 'A' : MAKE ('A', 'ARROW ('); 'B' : MAKE ('B', 'BOX ('); 'C' : MAKE ('C', 'CIRCLE ('); 'S' : MAKE ('S', 'CircSeg ('); 'D' : MAKE ('D', 'DRAW ('); 'G' : MAKE ('G', 'GRAPH ('); 'N' : MAKE ('N', 'NUMBER ('); 'W' : MAKE ('W', 'write ('); 'F' : MAKE ('F', 'Fill ('); {????} 'E' : SETP ('C', 'Active-color :'); 'P' : SETP ('P', 'Pallete :'); '@' : SETP ('@', '@ Segment Comment :'); '#' : SETP ('#', '# End Seg.Comment :'); 'T' : SETP ('T', 'T title Comment :'); '?' : HELP; ^[ : begin PROM_STR := 'COMMAND ?'; SW_MODE := false; end; else write (^G); end else CASE UPCASE(RESP) OF 'P' : begin CLR_AREA (0,0, 639,199,$0,1,0); EXEC_ALL (TRUE); readln(KBD); end; 'R' : EXEC_ALL (FALSE); 'S' : begin CODE_WRITE; SAVE_FILE := false; end; 'I' : CHNG_INPUT_AREA; '?' : HELP; 'K' : begin graphWindow (20,20,50,50); READLN (I); HIRESCOLOR (I); end; 'D' : begin PROM_STR := 'DRAWING ?'; SW_MODE := true; end; ^[ : SW_EXIT := true; else write (^G); end; until SW_EXIT; textmode; end; function CHECK_SAVE : boolean; begin gotoxy (5,25); write (^g, ^g, 'The file in memory :',CODE_in_MEM, 'has not been saved, SAVE IT ? (Y/N)'); repeat RESP := Upcase (INPUT_CHAR); until RESP in ['Y','N']; CHECK_SAVE := (RESP = 'Y'); end; procedure NO_DEF; begin gotoxy (10,22); writeln ('There in NO file name defined', ^G, ^G); writeln ('Use the CREATE, LOAD or RENAME options to define a name'); readln; end; procedure GET_FN; begin write ('The existing file names are:':53); LIST_GET_FILEN ('L', '????????.cod-', FNAME, RESP); gotoxy (20,21); write ('Give NEW File Name (w/o ext.) ?:'); read (FNAME); if FNAME <> '' then begin CFNAME := FNAME + '.cod'; CODE_in_MEM := CFNAME; assign (CODEFILE, CFNAME); end; end; begin { MAIN } { for i := 1 to NLIM do STNG [i] := ''; } TOP := 0; SW_CARD := True; SAVE_FILE := false; CODE_in_MEM := '-none-'; READ_SCREENS ('EDGRA.men'); ITM := 1; repeat DISPLAY_PAGE (1, 0, 1); gotoxy (28,3); write (DefaultDrive); gotoxy (28,4); write (CODE_in_MEM); ITM := CHOOSE_LINES (1, ITM, 10, 0); case ITM of 1 : HELP; {ed} 2 : if CODE_in_MEM = '-none-' then NO_DEF else EDIT; {Run} 3 : if CODE_in_MEM = '-none-' then NO_DEF else begin SW_COLOR := true; SW_CARD := true; HIRES_MODE := true; INCX := 2; RUN_GRAFI (CFNAME, INCX, resp, 0, 0); end; {List} 4 : if CODE_in_MEM = '-none-' then NO_DEF else CODE_LIST; {Crea} 5 : begin if SAVE_FILE then if CHECK_SAVE then CODE_WRITE; ClrScr; writeln ('C R E A T E':45); GET_FN; if FNAME <> '' then begin TOP := 0; TOP_SEGMENT := 0; TOP_NUMB := 0; end end; {Load} 6 : begin if SAVE_FILE then if CHECK_SAVE then CODE_WRITE; ClrScr; LIST_GET_FILEN ('G', '????????.cod-', FNAME, RESP); if RESP <> ^[ then begin CFNAME := FNAME + '.cod'; CODE_in_MEM := CFNAME; assign (CODEFILE, CFNAME); CODE_READ; end; end; {Save} 7 : if CODE_in_MEM = '-none-' then NO_DEF else begin CODE_WRITE; SAVE_FILE := false; end; 8 : begin ClrScr; writeln ('R E N A M E':45); GET_FN; end; 9 : SET_DRIVE ( SCRIO_CHAR (10, 21,'Enter new drive') ); 10 : begin ClrScr; LIST_GET_FILEN ('L', '????????.cod-', FNAME, RESP); end; end; until ITM = 0; if SAVE_FILE then if CHECK_SAVE then CODE_WRITE; CLRSCR; end. '@' : begin { Define Segment } if TOP_SEGMENT >= TOPSEG_LIM then ERROR (3) else begin TOP_SEGMENT := TOP_SEGMENT + 1; COLOR_SEG [TOP_SEGMENT,1] := TOP + 1; { begin_line } COLOR_SEG [TOP_SEGMENT,2] := 0; { end_line } if TOP_SEGMENT > 1 then COLOR_SEG [TOP_SEGMENT-1,2] := TOP - 1; { end_line } read (CODEFILE, STNG[TOP]); end; end; '#' : if TOP_SEGMENT > 0 then COLOR_SEG [TOP_SEGMENT,2] := TOP - 1; { end_line } 'T' : begin TITLE_SEG [1] := TOP + 1; { Tiles !! } read (CODEFILE, STNG[TOP]); end; 'Q' : begin { End Ploting } TOP := TOP - 1; { Do NOT keep Q } if (TOP_SEGMENT > 0) and (COLOR_SEG [TOP_SEGMENT,2] = 0) then COLOR_SEG [TOP_SEGMENT,2] := TOP; { end_line } TITLE_SEG [2] := TOP; end;