home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1999 April / VPR9904A.BIN / Vpr_data / Special / Yoolw101 / Yoolw101.lzh / draw.yo < prev    next >
Lisp/Scheme  |  1998-03-21  |  4KB  |  156 lines
  1. (de 'cls '(lambda(no x y)(gr_boxf no 0 0 x y (rgb 255 255 255))))
  2. (de 'color '(lambda(x)(switch x
  3.   (0 (rgb 0 0 0))
  4.   (1 (rgb 0 0 255))
  5.   (2 (rgb 255 0 0))
  6.   (3 (rgb 255 0 255))
  7.   (4 (rgb 0 255 0))
  8.   (5 (rgb 0 255 255))
  9.   (6 (rgb 255 255 0))
  10.   (7 (rgb 255 255 255))
  11.   (t (rgb 0 0 0))
  12. )))
  13. (de 'menu '(lambda(no mode col)(prog(c)
  14.   (gr_box no 0 0 16 16 0)
  15.   (gr_box no 0 16 16 32 0)
  16.   (gr_box no 0 32 16 48 0)
  17.   (gr_box no 0 48 16 64 0)
  18.   (switch mode
  19.     (1 (prog()
  20.       (gr_boxf no 1 1 15 15 (rgb 255 0 0))
  21.       (gr_boxf no 1 17 15 31 (rgb 255 255 255))
  22.       (gr_boxf no 1 33 15 47 (rgb 255 255 255))
  23.       (gr_boxf no 1 49 15 63 (rgb 255 255 255))
  24.     ))
  25.     (2 (prog()
  26.       (gr_boxf no 1 1 15 15 (rgb 255 255 255))
  27.       (gr_boxf no 1 17 15 31 (rgb 255 0 0))
  28.       (gr_boxf no 1 33 15 47 (rgb 255 255 255))
  29.       (gr_boxf no 1 49 15 63 (rgb 255 255 255))
  30.     ))
  31.     (3 (prog()
  32.       (gr_boxf no 1 1 15 15 (rgb 255 255 255))
  33.       (gr_boxf no 1 17 15 31 (rgb 255 255 255))
  34.       (gr_boxf no 1 33 15 47 (rgb 255 0 0))
  35.       (gr_boxf no 1 49 15 63 (rgb 255 255 255))
  36.     ))
  37.     (t (prog()
  38.       (gr_boxf no 1 1 15 15 (rgb 255 255 255))
  39.       (gr_boxf no 1 17 15 31 (rgb 255 255 255))
  40.       (gr_boxf no 1 33 15 47 (rgb 255 255 255))
  41.       (gr_boxf no 1 49 15 63 (rgb 255 255 255))
  42.     ))
  43.   )
  44.   (gr_line no 4 4 12 12 0)
  45.   (gr_circle no 4 20 12 28 0)
  46.   (gr_box no 4 38 12 42 0)
  47.   (gr_symbol no 2 52 "End" 0 8 0)
  48.   color_box
  49.   (setq c 0)
  50.   label0
  51.   (gr_boxf no 16 (* c 16) 32 (+ (* c 16) 16) (color c))
  52.   (cond ((eq col c)(gr_box no 16 (* c 16) 32 (+ (* c 16) 16) (rgb 255 0 0))))
  53.   (setq c (++ c))
  54.   (cond ((< c 7)(go label0)))
  55. )))
  56. (de 'draw '(lambda(x y)(prog(vx vy mode col btn_count mainw menuw)
  57.   (setq mainw (gr_open x y))
  58.   (setq menuw (gr_open 34 132 0))
  59.   (setq vx x)
  60.   (setq vy y)
  61.   (gr_vsize mainw x y)
  62.   (cls mainw vx vy)
  63.   (gr_box mainw 0 0 (- vx 1) (- vy 1) 0)
  64.   (setq mode 0)
  65.   (setq col 0)
  66.   (menu menuw mode col)
  67.   (setq btn_count 0)
  68.   (loop(mx my mx0 my0 mxy gxy menux menuy)
  69.     (cond ((eq mode -1)(return t)))
  70.     (setq mxy (ms_left))
  71.     (setq gxy (gr_xy mainw))
  72.     (setq mx (+ (caadr mxy) (car gxy)))
  73.     (setq my (+ (cdadr mxy) (cdr gxy)))
  74. ;(print (cons mx my))
  75.     (setq menux (truncate(/ (caadr mxy) 16)))
  76.     (setq menuy (truncate(/ (cdadr mxy) 16)))
  77. ;(print (cons menux menuy))
  78.     (cond
  79.       ((eq (car mxy) menuw)(prog()
  80.         (if (and (eq menux 0) (< menuy 4))
  81.           (switch menuy
  82.             (0 (prog()
  83.               (setq mode 1)
  84.               (setq btn_count 0)
  85.               (menu menuw mode col)
  86.             ))
  87.             (1 (prog()
  88.               (setq mode 2)
  89.               (setq btn_count 0)
  90.               (menu menuw mode col)
  91.             ))
  92.             (2 (prog()
  93.               (setq mode 3)
  94.               (setq btn_count 0)
  95.               (menu menuw mode col)
  96.             ))
  97.             (3 (return (setq mode -1)))
  98.           )
  99.         )
  100.         (if (and (eq menux 1) (< menuy 7))(prog()
  101.           (setq col menuy)
  102.           (menu menuw mode col)
  103.         ))
  104.       ))
  105.       (t (switch mode
  106.         (1 (prog()
  107.           (cond
  108.             ((eq btn_count 0)(prog()
  109.               (setq mx0 mx)
  110.               (setq my0 my)
  111.               (setq btn_count 1)
  112.             ))
  113.             (t (prog()
  114.               (gr_line mainw mx0 my0 mx my (color col))
  115.               (setq btn_count 0)
  116.             ))
  117.           )
  118.         ))
  119.         (2 (prog()
  120.           (cond
  121.             ((eq btn_count 0)(prog()
  122.               (setq mx0 mx)
  123.               (setq my0 my)
  124.               (setq btn_count 1)
  125.             ))
  126.             (t (prog()
  127.               (gr_circle mainw mx0 my0 mx my (color col))
  128.               (setq btn_count 0)
  129.             ))
  130.           )
  131.         ))
  132.         (3 (prog()
  133.           (cond
  134.             ((eq btn_count 0)(prog()
  135.               (setq mx0 mx)
  136.               (setq my0 my)
  137.               (setq btn_count 1)
  138.             ))
  139.             (t (prog()
  140.               (gr_box mainw mx0 my0 mx my (color col))
  141.               (setq btn_count 0)
  142.             ))
  143.           )
  144.         ))
  145.       ))
  146.     )
  147.   )
  148.   (gr_close mainw)
  149.   (gr_close menuw)
  150. )))
  151. "          Windowsアプリケーション例"
  152. "(draw ウインドの横幅 ウインドの縦の長さ)：オペレーションウインドと"
  153. "        メインウインドの２つのウインドを開き、オペレーションウイン"
  154. "        ドで図形と色を選択し、メインウインドに図形を描く。"
  155.  
  156.