/[gcl]/gcl/lsp/gcl_littleXlsp.lsp
ViewVC logotype

Diff of /gcl/lsp/gcl_littleXlsp.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by camm, Sun Sep 14 02:30:35 2003 UTC revision 1.2 by camm, Sun Sep 14 02:43:06 2003 UTC
# Line 0  Line 1 
1    ;;This file is included as a demonstration of how to link in low level
2    ;;C code.   It is also useful! [comments by wfs]
3    ;;Author: Mark Ring  (ring@cs.utexas.edu)
4    
5    ;; In the next comment we explain how to link in the file
6    ;; and then a sample usage.
7    
8    #|
9    If you have si::faslink you may use:
10    (si::faslink "/public/gcl/lsp/littleXlsp.o" "/public/gcl/o/littleXwin.o -lX11 -lc")
11    
12    To avoid using faslink which is much less portable,
13    when building the gcl image you may add
14    EXTRAS=${ODIR}/littleXwin.o
15    LIBS= -lX -lm -lg
16    to the h/machine.defs, redo the add-defs machine, and remake so that
17    the low level X code will be linked in.
18    Then you may simply
19    (load "/public/gcl/lsp/littleXlsp.o")
20    
21    ;;Now you may try the following examples:
22    
23    
24    
25    (setq W1 (open-window))
26    (setq W2 (open-window))
27    (resize-window w1 200 150)
28    (resize-window w2 240 225)
29    
30    (set-background w1 "red")
31    (clear-window w1)
32    (set-foreground "blue")
33    
34    (draw-line w1 5 5 100 5)
35    (draw-line w1 100 100 100 5)
36    (draw-line w1 100 100 5 100)
37    (dotimes (i 20)
38      (draw-line w1 5 (* i 5) (* i 5) (* i 5)))
39    (dotimes (i 20)
40      (erase-line w1 (+ 7 (* i 5)) 10 (+ 7 (* i 5)) 95))
41    (use-font "fixed")
42    (draw-text w1 "A Design" 10 112)
43    (clear-text w1 "De" 22 112)
44    
45    (dotimes (i 25)
46      (set-background w2 (format nil "#~2,'0X~2,'0X~2,'0X" (* i 10) (* i 10) (* i 10)))
47      (clear-window w2))
48    
49    (set-foreground "black")
50    (dotimes (i 20)
51      (draw-arc w2 5 100 100 (- 100 (* i 5)) 0 (* 360 64)))
52    (dotimes (i 20)
53      (draw-arc w2 5 (- 100 (* i 5)) 100 (* i 5) 0 (* 360 64)))
54    (set-arc-mode 'pie)
55    (dotimes (i 10)
56      (fill-arc w2 115 5 100 100 (* i 64 36) (* 64 18)))
57    (set-arc-mode 'chord)
58    (dotimes (i 10)
59      (fill-arc w2 115 105 100 100 (* i 64 36) (* 64 36 3)))
60    (dotimes (i 5)
61      (clear-arc w2 115 105 100 100 (* i 64 36 2) (* 64 36 2)))
62    (use-font "-b&h-lucidabright-demibold-i-normal--18-180-75-75-p-107-iso8859-1")
63    (draw-text w2 "A Bunch of Wierd Things" 2 220)
64    
65    (clear-window w1)
66    
67    (close-window w1)
68    (close-window w2)
69    |#
70    
71    
72    
73    
74    
75    ;;; Open a window.  Return window ID as an Integer
76    (defentry open-window () (int open_window))
77    
78    ;;; Close given window.
79    ;;;   Parameter 1:  Window ID.
80    (defentry close-window (int) (int close_window))
81    
82    ;;; Clear a window of its contents.
83    ;;;   Parameter 1:  Window ID.
84    (defentry clear-window (int) (int clear_window))
85    
86    ;;; Draw a line in a window.
87    ;;;   Parameter 1:  Window ID.
88    ;;;   Parameter 2:  left-most x coordinate
89    ;;;   Parameter 3:  top-most y coordinate
90    ;;;   Parameter 4:  right-most x coordinate
91    ;;;   Parameter 5:  bottom-most y coordinate
92    (defentry draw-line (int int int int int) (int draw_line))
93    
94    ;;; Erase a line from a window.
95    ;;;   Parameter 1:  Window ID.
96    ;;;   Parameter 2:  left-most x coordinate
97    ;;;   Parameter 3:  top-most y coordinate
98    ;;;   Parameter 4:  right-most x coordinate
99    ;;;   Parameter 5:  bottom-most y coordinate
100    (defentry erase-line (int int int int int) (int erase_line))
101    
102    ;;; Draw an arc in a window. (See X Documentation).
103    ;;;   Parameter 1:  Window ID.
104    ;;;   Parameter 2:  left-most x coordinate
105    ;;;   Parameter 3:  top-most y coordinate
106    ;;;   Parameter 4:  width of square
107    ;;;   Parameter 5:  height of square
108    ;;;   Parameter 6:  starting position: angle 1 (from 3:00)
109    ;;;   Parameter 7:  ending position: angle 2 (from angle 1)
110    ;;;        Angles are specified in 64ths of a degree and go counter-clockwise
111    (defentry draw-arc (int int int int int int int) (int draw_arc))
112    
113    ;;; Clear an arc from a window. (See X Documentation).
114    ;;;   Parameter 1:  Window ID.
115    ;;;   Parameter 2:  left-most x coordinate
116    ;;;   Parameter 3:  top-most y coordinate
117    ;;;   Parameter 4:  width of square
118    ;;;   Parameter 5:  height of square
119    ;;;   Parameter 6:  starting position: angle 1 (from 3:00)
120    ;;;   Parameter 7:  ending position: angle 2 (from angle 1)
121    ;;;        Angles are specified in 64ths of a degree and go counter-clockwise
122    (defentry clear-arc (int int int int int int int) (int clear_arc))
123    
124    ;;; Draw a filled arc in a window. (See X Documentation).
125    ;;;   Parameter 1:  Window ID.
126    ;;;   Parameter 2:  left-most x coordinate
127    ;;;   Parameter 3:  top-most y coordinate
128    ;;;   Parameter 4:  width of square
129    ;;;   Parameter 5:  height of square
130    ;;;   Parameter 6:  starting position: angle 1 (from 3:00)
131    ;;;   Parameter 7:  ending position: angle 2 (from angle 1)
132    ;;;        Angles are specified in 64ths of a degree and go counter-clockwise
133    (defentry fill-arc  (int int int int int int int) (int fill_arc))
134    
135    ;;; Resize a window.
136    ;;;   Parameter 1:  Window ID.
137    ;;;   Parameter 2:  new width
138    ;;;   Parameter 3:  new height
139    (defentry resize-window (int int int) (int resize_window))
140    
141    ;;; Raise a window to the front.
142    ;;;   Parameter 1:  Window ID.
143    (defentry raise-window (int) (int raise_window))
144    
145    ;;; Draw Text in a window.
146    ;;;   Parameter 1:  Window ID.
147    ;;;   Parameter 2:  text string
148    ;;;   Parameter 3:  left-most x coordinate
149    ;;;   Parameter 4:  top-most y coordinate
150    (defentry draw-text-2 (int object int int) (int draw_text))
151    (defun    draw-text (window string x y)
152      (draw-text-2 window (get-c-string string) x y))
153    
154    ;;; Clear text from a window
155    ;;;   Parameter 1:  Window ID
156    ;;;   Parameter 2:  text string
157    ;;;   Parameter 3:  left-most x coordinate
158    ;;;   Parameter 4:  top-most y coordinate
159    (defentry clear-text-2 (int object int int) (int erase_text))
160    (defun    clear-text (window string x y)
161      (clear-text-2 window (get-c-string string) x y))
162    
163    ;;; Set arc-mode to be Pie or Chord
164    ;;;   Parameter 1:  'PIE or 'CHORD
165    (defentry set-arc-mode-2 (int) (int set_arc_mode))
166    (defun    set-arc-mode (pie-or-chord)
167      (if (eq pie-or-chord 'pie)
168          (set-arc-mode-2 1)
169          (set-arc-mode-2 0)))
170    
171    ;;; Use a particular font in a given window
172    ;;;   Parameter 1:  font name
173    (defentry use-font-2 (object) (int use_font))
174    (defun    use-font (string)
175      (use-font-2 (get-c-string string)))
176    
177    ;;; Set background color of window
178    ;;;   Parameter 1:  Window ID
179    ;;;   Parameter 2:  color name (string)
180    (defentry set-background-2 (int object) (int set_background))
181    (defun    set-background   (window string)
182      (set-background-2 window (get-c-string string)))
183    
184    ;;; Set foreground color
185    ;;;   Parameter 1:  color name (string)
186    (defentry set-foreground-2 (object) (int set_foreground))
187    (defun    set-foreground   (string)
188      (set-foreground-2 (get-c-string string)))
189    
190    ;;;----------------------------------------------------------------------
191    ;;; General routines.
192    (defCfun "object get_c_string(s) object s;" 0
193      " return(s->st.st_self);"
194      )
195    (defentry get_c_string_2 (object) (object get_c_string))
196    
197    /* make sure string is null terminated */
198    (defun get-c-string (string)
199      (get_c_string_2 (concatenate 'string string "")))
200    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26