File: mouse.l

package info (click to toggle)
euslisp 9.27%2Bdfsg-7
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye
  • size: 55,344 kB
  • sloc: ansic: 41,162; lisp: 3,339; makefile: 256; sh: 208; asm: 138; python: 53
file content (114 lines) | stat: -rw-r--r-- 4,164 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
(defun long-to-4byte-string (v)
  (let ((str (make-string 4)))
    (dotimes (i 4 str)
	     (setf (aref str (- 3 i)) (logand v #xff))
	     (setq v (ash v -4)))))
(defun itimer-string (usec)
  (let
      ((str 
	(concatenate
	 string
	 (long-to-4byte-string (floor (/ usec 1000000)))
	 (long-to-4byte-string (floor (mod usec 1000000))))))
    (print str)
    (concatenate string str str)))

(defun-c-callable quit-proc (i e)
  (window_destroy Ex1-F))
(setq *last-time* 0)
(setq *set* nil)
(defun show-msg (window-cadr event msg)
  (when (not *set*) (event_set_time event 100)
	(setq *set* t))
  (cond
   ((equal window-cadr ex1-c)
    (let ((we (canvas_window_event ex1-c event)))
      (pw_text (canvas_pixwin ex1-c) 10 30 pix_src 0
	       (format nil "time:~a      " (event_time we)))
      (format t "time:~a~%" (event_time we))
      ;;      (format t "time difference:~a~%" (- last-time (event_time we)))
      (setq last-time (event_time we))
      ;;      (format t "event=~s,we=~s~%" event we)
      ;;      (format t "x=~s,y=~s~%" (event_x event) (event_y event))
      ;;      (format t "wx=~s,wy=~s~%" (event_x we) (event_y we))
      (pw_text (canvas_pixwin ex1-c) 10 50 pix_src 0
	       (setq msg (format nil "c:~a at ~s ~s~a    " msg
				 (event_x we) (event_y we)
				 (if
				     (event_is_button event)
				     (cond
				      ((event_is_up we) " up.")
				      ((event_is_down we) " down.")
				      (t "."))
				   "."))))
      ;;      (format t "~a~%" msg)
      ))
   ((equal window-cadr ex1-p)
    (let ((we (panel_window_event ex1-p event)))
      (pw_text (canvas_pixwin ex1-c) 10 40 pix_src 0
	       (format nil "p:~a at ~s ~s,~s.    " msg
		       (event_x we) (event_y we)
		       (when
			(event_is_button we)
			(cond
			 ((event_is_up we) 'up)
			 ((event_is_down we) 'down)
			 (t "")))))))
   ((equal window-cadr ex1-f)
    (pw_text (canvas_pixwin ex1-c) 10 30 pix_src 0
	     (format nil "~a on frame.    " msg)))
   ))
(defun-c-callable ex1-window-handler (window-cadr event)
  (let ((id (event_id event)))
    (cond
     ((equal id loc_drag) (show-msg window-cadr event "dragging"))
     ((equal id loc_move) (show-msg window-cadr event "moving"))
     ((equal id loc_still) (show-msg window-cadr event "still"))
     ((equal id ms_left) (show-msg window-cadr event "left"))
     ((equal id ms_right) (show-msg window-cadr event "right"))
     ((equal id ms_middle) (show-msg window-cadr event "middle"))
     ((equal id loc_winenter) (show-msg window-cadr event "winenter"))
     ((equal id loc_winexit)  (show-msg window-cadr event "winexit"))
     ((equal id loc_rgnenter)  (show-msg window-cadr event "rgnenter"))
     ((equal id loc_rgnexit)  (show-msg window-cadr event "rgnexit"))
     )
    ))
(defun ex1 nil
  (notify_do_dispatch)
  (setq count 0)
  (setq Ex1-F
	(window_create_frame
	 null frame_label "Eusview ex1 By M.I 1988" win_x 800 win_y 30
	 win_event_proc (pod-address 'ex1-window-handler)
	 frame_icon
	 (icon_create icon_image
		      (icon_load_mpr
		       "/usr/include/images/hello_world.icon"
		       (setq errbuf (make-string 32))))))
  (setq ex1-p
	(window_create_panel
	 Ex1-F
	 win_event_proc (pod-address 'ex1-window-handler)
	 win_font 
	 (pf_open "/usr/lib/fonts/fixedwidthfonts/screen.b.12")))
  (panel_create_message
   ex1-p panel_label_string "Hit button to quit.")
  (panel_create_button
   ex1-p panel_label_image (panel_button_image ex1-p "quit" 5)
   panel_notify_proc (pod-address 'quit-proc))
  (window_fit ex1-p)
  (setq ex1-c (window_create_canvas
	       Ex1-F win_width 300 win_height 70 win_x 0 win_below ex1-p
	       win_ignore_pick_event loc_still
	       win_consume_pick_event loc_drag
	       win_consume_pick_event win_in_transit_events
	       win_consume_pick_event win_mouse_buttons
	       win_event_proc (pod-address 'ex1-window-handler)))
  (setq ex1-pw (canvas_pixwin ex1-c))
  (pw_polygon_2 ex1-pw 0 0 1 #(3) #(10 10 100 10 50 50) pix_set 0 0 0)
  (pw_polyline ex1-pw 0 0 3
	       (list #f(50 10) #f(150 10) #f(100 50)) 0 0 0 pix_set)
  (pw_polypoint ex1-pw 0 0 3 '(10 20 200 20 150 50) pix_set)
  (window_fit Ex1-F)
  (window_set Ex1-F win_show true)
  )