|
|
1.1 ! root 1: # GPACK(2) ! 2: # ! 3: # Graphics Package ! 4: # ! 5: # Stephen B. Wampler ! 6: # ! 7: # Last modified 7/10/83 ! 8: # ! 9: ### note - currently no clipping is performed. needs work. ! 10: ! 11: global _wno # current window runner ! 12: global Window ! 13: global Wscale # list of window attributes ! 14: global MODE, ESC # chromatic commands ! 15: global OFF, ON ! 16: global DOT, VECTOR, RECTANGLE, CIRCLE, ARC, CONCVECT, INCDOT ! 17: global XMAX, YMAX ! 18: global BLACK, BLUE, GREEN, CYAN, RED, MAGENTA, YELLOW, WHITE, BLINK ! 19: ! 20: # set the mode ! 21: # ! 22: procedure clip(mode) ! 23: suspend Window[_wno].cmode <- mode # mode is ON/OFF ! 24: end ! 25: ! 26: # clip the object ! 27: # ! 28: procedure clipped(object) ! 29: case type(object) of { ! 30: default: return object ! 31: } ! 32: end ! 33: ! 34: # set the color ! 35: # ! 36: procedure color(colr) ! 37: if colr % 8 ~= Window[_wno].fc then { ! 38: writes(MODE,"C",colr % 8) ! 39: Window[_wno].fc := colr % 8 ! 40: } ! 41: return ! 42: end ! 43: ! 44: # set the background color ! 45: # ! 46: procedure bckgrnd(colr) ! 47: if colr % 8 ~= Window[_wno].bc then { ! 48: writes(MODE,"M") ! 49: writes(MODE,"C",colr % 8) ! 50: Window[_wno].bc := colr % 8 ! 51: writes(MODE,"N") ! 52: } ! 53: return ! 54: end ! 55: ! 56: # set the cursor color ! 57: # ! 58: procedure curcol(colr) ! 59: writes(MODE,"Q",colr % 8) ! 60: return ! 61: end ! 62: ! 63: # enable particular color guns ! 64: # ! 65: procedure enable(colr) ! 66: writes(MODE,":","0123456789ABCDEF"[colr+1]) ! 67: return ! 68: end ! 69: ! 70: ! 71: ! 72: ! 73: # draw an object ! 74: # ! 75: procedure draw(object) ! 76: local pts, p0 ! 77: if /object then fail ! 78: object := clipped(object) | fail ! 79: every _plot() do { # switch to plot mode ! 80: case type(object) of { ! 81: "co-expression": while draw(@object) ! 82: "motion": { ! 83: _xydel(object.xdel,object.ydel) ! 84: } ! 85: "point": { ! 86: _point(object.x,object.y) ! 87: } ! 88: "dot": { ! 89: mode(DOT) ! 90: _point(object.x,object.y) ! 91: } ! 92: "line": { ! 93: mode(VECTOR) ! 94: _point(object.a.x,object.a.y) ! 95: _point(object.b.x,object.b.y) ! 96: } ! 97: "box": { ! 98: mode(RECTANGLE) ! 99: _point(object.a.x,object.a.y) ! 100: _point(object.b.x,object.b.y) ! 101: } ! 102: "circle": { ! 103: mode(CIRCLE) ! 104: _point(object.center.x,object.center.y) ! 105: _number(object.radius) ! 106: } ! 107: "arc": { ! 108: mode(ARC) ! 109: _point(object.center.x,object.center.y) ! 110: _number(object.radius) ! 111: _number(object.start) ! 112: _number(object.stop) ! 113: } ! 114: "points": { ! 115: mode(DOT) ! 116: every draw(!(object.pts)) ! 117: } ! 118: "lines": { ! 119: pts := create !object.pts ! 120: p0 := @pts ! 121: mode(VECTOR) ! 122: while draw(line(.p0,p0 := @pts)) ! 123: } ! 124: "polygon": { ! 125: mode(VECTOR) ! 126: draw(lines(object.pts)) ! 127: draw(line(object.pts[0],object.pts[1])) ! 128: } ! 129: "incdots": { ! 130: mode(INCDOT) ! 131: draw(object.start) ! 132: every draw(!object.motions) ! 133: } ! 134: default : ! 135: write(&errout,"don't know how to draw ",type(object)) ! 136: } ! 137: } ! 138: ! 139: return ! 140: end ! 141: ! 142: ! 143: # clear the screen ! 144: ! 145: procedure erase() ! 146: writes("\014") ! 147: return ! 148: end ! 149: ! 150: # switch to fill mode ! 151: # ! 152: procedure _fill() ! 153: if Window[_wno].fmode == OFF then { ! 154: writes(MODE,"F") ! 155: suspend Window[_wno].fmode <- ON ! 156: writes(MODE,"L") ! 157: fail ! 158: } ! 159: return ! 160: end ! 161: ! 162: # leave fill mode ! 163: # ! 164: procedure _nofill() ! 165: if Window[_wno].fmode == ON then { ! 166: writes(MODE,"L") ! 167: suspend Window[_wno].fmode <- OFF ! 168: writes(MODE,"F") ! 169: fail ! 170: } ! 171: return ! 172: end ! 173: ! 174: # initialize ! 175: # ! 176: procedure ginit() ! 177: MODE := "\01" ! 178: ESC := "\033" ! 179: ON := "on" ! 180: OFF := "off" ! 181: XMAX := 511 ! 182: YMAX := 511 ! 183: Window := list(4) ! 184: every Window[1 to 4] := wind(OFF,OFF,OFF,OFF,ON,"",-1,-1,point(0,0),point(511,511)) ! 185: every window(1 to 4) do { ! 186: writes(MODE,"\25") # plot off ! 187: writes(MODE,"L") # fill off ! 188: writes(MODE,"R") # roll on ! 189: } ! 190: Wscale := list(4) ! 191: every Wscale[1 to 4] := scaling(1,0,1,0) ! 192: _wno := 1 ! 193: DOT := "%" ! 194: VECTOR := "'" ! 195: RECTANGLE := "+" ! 196: CIRCLE := "*" ! 197: ARC := ")" ! 198: CONCVECT := ")" ! 199: INCDOT := "&" ! 200: BLACK := 0 ! 201: BLUE := 1 ! 202: GREEN := 2 ! 203: CYAN := 3 ! 204: RED := 4 ! 205: MAGENTA := 5 ! 206: YELLOW := 6 ! 207: WHITE := 7 ! 208: BLINK := 8 ! 209: end ! 210: ! 211: # set plot submode (internal routine) ! 212: # ! 213: procedure mode(newmode) ! 214: if newmode ~== Window[_wno].psubmode then { ! 215: writes(newmode) ! 216: suspend Window[_wno].psubmode <- newmode ! 217: writes(Window[_wno].psubmode) ! 218: fail ! 219: } ! 220: return ! 221: end ! 222: ! 223: # move cursor to (x,y) (internal routine) ! 224: # ! 225: procedure movcur(x,y) ! 226: writes(MODE,"U") ! 227: _point(x,y) ! 228: return ! 229: end ! 230: ! 231: # switch to plot mode ! 232: # ! 233: procedure _plot() ! 234: if Window[_wno].pmode == OFF then { ! 235: Window[_wno].psubmode := " " ! 236: writes(MODE,"G") ! 237: suspend Window[_wno].pmode <- ON ! 238: writes("\25") ! 239: fail ! 240: } ! 241: return ! 242: end ! 243: ! 244: # switch to character mode ! 245: # ! 246: procedure _char() ! 247: if Window[_wno].pmode == ON then { ! 248: writes("\25") ! 249: suspend Window[_wno].pmode <- OFF ! 250: writes(MODE,"G") ! 251: fail ! 252: } ! 253: return ! 254: end ! 255: ! 256: ! 257: ! 258: ! 259: ! 260: # put out a point (x,y) (internal routines) ! 261: ! 262: # write a point ! 263: # ! 264: procedure _point(x,y) ! 265: _number(xfit(x)) ! 266: _number(yfit(y)) ! 267: return ! 268: end ! 269: ! 270: # write a number ! 271: # ! 272: procedure _number(n) ! 273: if n <= 99 then ! 274: writes(n,",") ! 275: else ! 276: writes(n) ! 277: return ! 278: end ! 279: ! 280: ! 281: # graphic record types ! 282: ! 283: record point(x,y) ! 284: record dot(x,y) ! 285: record line(a,b) ! 286: record box(a,b) ! 287: record circle(center,radius) ! 288: record arc(center,radius,start,stop) ! 289: record points(pts) ! 290: record lines(pts) ! 291: record polygon(pts) ! 292: record incdots(start,motions) ! 293: record motion(xdel,ydel) ! 294: ! 295: # window records ! 296: ! 297: record wind(pmode,smode,cmode,fmode,rmode,psubmode,fc,bc,lowerleft,upperright) ! 298: record scaling(xslope,xinter,yslope,yinter) ! 299: ! 300: ! 301: # reset windows ! 302: # ! 303: procedure restore() ! 304: ! 305: every window(3 to 0 by -1) do { ! 306: setscale(0,0,511,511,0,0,511,511) ! 307: wsize(0,0,511,511) ! 308: _char() ! 309: _roll() ! 310: enable(WHITE+BLINK) ! 311: } ! 312: ! 313: end ! 314: ! 315: ! 316: # turn on roll ! 317: # ! 318: procedure _roll() ! 319: if Window[_wno].rmode ~== ON then { ! 320: writes(MODE,"R") ! 321: suspend Window[_wno].rmode <- ON ! 322: writes(MODE,"P") ! 323: fail ! 324: } ! 325: return ! 326: end ! 327: ! 328: # turn off roll ! 329: # ! 330: procedure _noroll() ! 331: if Window[_wno].rmode ~== OFF then { ! 332: writes(MODE,"P") ! 333: suspend Window[_wno].rmode <- OFF ! 334: writes(MODE,"R") ! 335: fail ! 336: } ! 337: return ! 338: end ! 339: ! 340: ! 341: ! 342: ! 343: ! 344: ! 345: ! 346: procedure setscale(xmin,ymin,xmax,ymax,colmin,rowmin,colmax,rowmax) ! 347: ! 348: Wscale[_wno].xslope := real(colmax-colmin) / (xmax-xmin) ! 349: Wscale[_wno].xinter := colmin - xmin * Wscale[_wno].xslope ! 350: ! 351: Wscale[_wno].yslope := real(rowmax-rowmin) / (ymax-ymin) ! 352: Wscale[_wno].yinter := rowmin - (ymin * Wscale[_wno].yslope) ! 353: return ! 354: end ! 355: ! 356: procedure xfit(x) ! 357: if Window[_wno].smode === ON then ! 358: return integer(Wscale[_wno].xslope * x + Wscale[_wno].xinter + 0.5) ! 359: else return integer(x + 0.5) ! 360: end ! 361: ! 362: procedure yfit(y) ! 363: if Window[_wno].smode === ON then ! 364: return integer(Wscale[_wno].yslope * y + Wscale[_wno].yinter + 0.5) ! 365: else return integer(y + 0.5) ! 366: end ! 367: ! 368: procedure scale(pt) ! 369: if Window[_wno].smode === ON then ! 370: return point( ! 371: integer(Wscale[_wno].xslope * pt.x + Wscale[_wno].xinter + 0.5), ! 372: integer(Wscale[_wno].yslope * pt.y + Wscale[_wno].yinter + 0.5) ! 373: ) ! 374: else return pt ! 375: end ! 376: ! 377: procedure _scale(mode) ! 378: suspend Window[_wno].smode <- mode ! 379: end ! 380: ! 381: # place text on screen at (x,y) ! 382: # ! 383: procedure text(x,y,s) ! 384: every _char() do { ! 385: movcur(x,y) ! 386: writes(s) ! 387: } ! 388: return ! 389: end ! 390: ! 391: # switch to window w (0-3) ! 392: # ! 393: procedure window(w) ! 394: writes(ESC,"OA",w % 4) ! 395: _wno := w % 4 + 1 ! 396: return ! 397: end ! 398: ! 399: # set new window size ! 400: # ! 401: procedure wsize(x0,y0,x1,y1) ! 402: writes(MODE,"W") ! 403: _point(x0,y0) ! 404: _point(x1,y1) ! 405: Window[_wno].lowerleft := point(x0,y0) ! 406: Window[_wno].upperright := point(x1,y1) ! 407: return ! 408: end ! 409: ! 410: # output deltax, deltay to terminal ! 411: # ! 412: procedure _xydel(xdel,ydel) ! 413: local signx, signy, byte ! 414: static chars ! 415: initial chars := string(&cset) ! 416: signx := signy := 0 ! 417: if xdel < 0 then { ! 418: signx := 32 ! 419: xdel := -xdel ! 420: } ! 421: if ydel < 0 then { ! 422: signy := 4 ! 423: ydel := -ydel ! 424: } ! 425: byte := 64 + signx + xdel*8 + signy + ydel ! 426: writes(chars[65 + signx + (xdel % 4)*8 + signy + (ydel % 4)]) ! 427: return ! 428: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.