![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to xor.clu CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / X / xdemo|
Return to xor.clu CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / X / xdemo |
1.1 ! root 1: % from Lucasfilm Ltd. ! 2: ! 3: xordemo = proc () ! 4: bwidth: int := int$parse(xdemo_default("xor", "BorderWidth")) ! 5: except when not_found, overflow, bad_format: bwidth := 2 end ! 6: back: x_pixmap := x_display$white() ! 7: bdr: x_pixmap := x_display$black() ! 8: plane: int := 1 ! 9: forepix: int := BlackPixel ! 10: if x_display$cells() > 2 ! 11: then begin ! 12: r, g, b: int := x_parse_color(xdemo_default("xor", "Border")) ! 13: bdr := x_pixmap$tile(x_display$alloc_color(r, g, b)) ! 14: end except when not_found: end ! 15: cback: string := xdemo_default("xor", "Background") ! 16: except when not_found: cback := "" end ! 17: cfore: string := xdemo_default("xor", "Foreground") ! 18: except when not_found: cfore := "" end ! 19: if string$empty(cback) cand string$empty(cfore) ! 20: then exit done end ! 21: pixs: pixellist ! 22: pixs, plane := x_display$alloc_cells(1, 1, false) ! 23: back := x_pixmap$tile(pixs[1]) ! 24: r, g, b: int ! 25: if string$empty(cback) ! 26: then r, g, b := x_display$query_color(WhitePixel) ! 27: else r, g, b := x_parse_color(cback) ! 28: end ! 29: x_display$store_color(pixs[1], r, g, b) ! 30: if string$empty(cfore) ! 31: then r, g, b := x_display$query_color(BlackPixel) ! 32: else r, g, b := x_parse_color(cfore) ! 33: end ! 34: forepix := pixs[1] + plane ! 35: x_display$store_color(forepix, r, g, b) ! 36: end except when done: end ! 37: w: x_window, wid0, hgt0: int := x_cons("xor", back, bdr, ! 38: xdemo_geometry(), "=400x400+1+1", ! 39: 40, 40, bwidth) ! 40: w.name := "xor" ! 41: w.input := UnmapWindow ! 42: x_window$map(w) ! 43: w.input := ExposeWindow + UnmapWindow ! 44: ev: event := x_input$empty_event() ! 45: nobit: x_bitmap := x_bitmap$none() ! 46: while true do ! 47: x_window$clear(w) ! 48: sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w) ! 49: if width <= 30 cor height <= 30 ! 50: then x_window$destroy(w) ! 51: return ! 52: end ! 53: x0, x1, y0, y1, s: int ! 54: if width > height ! 55: then s := xorsize(width / 2, height) ! 56: y0 := (height - s) / 2 ! 57: y1 := y0 ! 58: x0 := (width / 2 - s) / 2 ! 59: x1 := width / 2 + x0 ! 60: else s := xorsize(width, height / 2) ! 61: x0 := (width - s) / 2 ! 62: x1 := x0 ! 63: y0 := (height / 2 - s) / 2 ! 64: y1 := height / 2 + y0 ! 65: end ! 66: mask: int := 341 ! 67: if random$next(3) ~= 0 ! 68: then mask := random$next(512) + 1 end ! 69: if random$next(3) ~= 0 ! 70: then x_window$pix_set(w, forepix, x1, y1, s, s) ! 71: x_window$pix_fill(w, 0, nobit, x1 + s / 2 - 1, y1 + s / 2 - 1, ! 72: 2, 2, GXinvert, plane) ! 73: end ! 74: count: int := 0 ! 75: while count ~= 0 cor ~x_input$pending() do ! 76: if count = 10 ! 77: then count := 0 ! 78: else count := count + 1 ! 79: end ! 80: x_window$move_area(w, x1, y1, s, s, x0, y0) ! 81: x_window$pix_set(w, forepix, x1, y1, s, s) ! 82: if mask // 2 = 1 ! 83: then x_window$copy_area(w, x0, y0, s, s, x1 - 1, y1, ! 84: GXxor, plane) ! 85: end ! 86: if (mask / 2) // 2 = 1 ! 87: then x_window$copy_area(w, x0, y0, s, s, x1 - 1, y1 - 1, ! 88: GXxor, plane) ! 89: end ! 90: if (mask / 4) // 2 = 1 ! 91: then x_window$copy_area(w, x0, y0, s, s, x1, y1 - 1, ! 92: GXxor, plane) ! 93: end ! 94: if (mask / 8) // 2 = 1 ! 95: then x_window$copy_area(w, x0, y0, s, s, x1 + 1, y1 - 1, ! 96: GXxor, plane) ! 97: end ! 98: if (mask / 16) // 2 = 1 ! 99: then x_window$copy_area(w, x0, y0, s, s, x1 + 1, y1, ! 100: GXxor, plane) ! 101: end ! 102: if (mask / 32) // 2 = 1 ! 103: then x_window$copy_area(w, x0, y0, s, s, x1 + 1, y1 + 1, ! 104: GXxor, plane) ! 105: end ! 106: if (mask / 64) // 2 = 1 ! 107: then x_window$copy_area(w, x0, y0, s, s, x1, y1 + 1, ! 108: GXxor, plane) ! 109: end ! 110: if (mask / 128) // 2 = 1 ! 111: then x_window$copy_area(w, x0, y0, s, s, x1 - 1, y1 + 1, ! 112: GXxor, plane) ! 113: end ! 114: if (mask / 256) // 2 = 1 ! 115: then x_window$copy_area(w, x0, y0, s, s, x1, y1, ! 116: GXxor, plane) ! 117: end ! 118: end ! 119: x_input$deq(ev) ! 120: if ev.kind = UnmapWindow ! 121: then x_input$deq(ev) end ! 122: end ! 123: end xordemo ! 124: ! 125: xorsize = proc (width, height: int) returns (int) ! 126: if width > height ! 127: then width := height end ! 128: width := width - 2 ! 129: height := 1 ! 130: while height <= width do ! 131: height := height * 2 ! 132: end ! 133: return(height / 2) ! 134: end xorsize
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.