Приложение HomeLisp

@Lambdik · Регистрация: 04.11.2012

Author24 — интернет-сервис помощи студентам

Мой первый калькулятор на HomeLisp.
До совершенства конечно не довел, но если последовательно клацать, то можно пользоваться.

Есть вопросы:
1). Как ограничить ввод в текстовое поле скажем до 10-и чисел?
2). Как блокировать ввод букв?

Кликните здесь для просмотра всего текста

Lisp

//****************************************
//  Программа отображения диалога my-Dlg. *
// ****************************************
(defun Calc ()
 
(dlgCreate 'my-Dlg 300 450 "Калькулятор" &HFFF3E8)
(dlgAddControl 'my-Dlg '_BUT_1 _BUTTON 25 300 40 40 '("Tahoma" 10.2 0 0 0) "1" &HFFF3E8)
(dlgAddControl 'my-Dlg '_TXT_1 _TEXT 25 25 240 60 '("Arial Unicode MS" 20 0 0 0) "" 0 -2147483640  16776439)
(dlgAddControl 'my-Dlg '_BUT_2  5  75 300 40 40 '("Tahoma" 10.2 0 0 0) "2" &HFFF3E8)
(dlgAddControl 'my-Dlg '_BUT_3  5  25 350 90 40 '("Tahoma" 10.2 0 0 0) "0" &HFFF3E8)
(dlgAddControl 'my-Dlg '_BUT_4  5 125 350 40 40 '("Tahoma" 10.2 0 0 0) "," &HFFF3E8)
(dlgAddControl 'my-Dlg '_BUT_5  5 175 350 40 40 '("Tahoma" 10.2 0 0 0) "+" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_6  5 225 300 40 90 '("Tahoma" 16.2 0 0 0) "=" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_7  5 175 300 40 40 '("Tahoma" 10.2 0 0 0) "-" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_8  5 125 300 40 40 '("Tahoma" 10.2 0 0 0) "3" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_but_9  5 175 250 40 40 '("Tahoma" 10.2 0 0 0) "*" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_10 5 175 200 40 40 '("Tahoma" 10.2 0 0 0) "/" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_11 5  25 250 40 40 '("Tahoma" 10.2 0 0 0) "4" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_12 5  25 200 40 40 '("Tahoma" 10.2 0 0 0) "7" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_13 5  75 250 40 40 '("Tahoma" 10.2 0 0 0) "5" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_14 5 125 250 40 40 '("Tahoma" 10.2 0 0 0) "6" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_15 5  75 200 40 40 '("Tahoma" 10.2 0 0 0) "8" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_16 5 125 200 40 40 '("Tahoma" 10.2 0 0 0) "9" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_17 5 225 250 40 40 '("Tahoma" 10.2 0 0 0) "sqr" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_18 5 225 200 40 40 '("Tahoma" 10.2 0 0 0) "%" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_19 5  75 150 40 40 '("Tahoma" 10.2 0 0 0) "CE" &HFFF3E8)
(dlgAddControl 'my-Dlg '_BUT_20 5 225 100 40 40 '("Tahoma"  7.8 0 0 0) "Close" &HFFF3E8)
(dlgPutPicture '_BUT_20 36)
(dlgAddControl 'my-Dlg '_BUT_21 5 175 100 40 40 '("Tahoma" 10.2 0 0 0) "M-" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_22 5 125 100 40 40 '("Tahoma" 10.2 0 0 0) "M+" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_23 5 175 150 40 40 '("Tahoma" 10.2 0 0 0) "+/-" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_24 5  75 100 40 40 '("Tahoma" 10.2 0 0 0) "MR" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_25 5  25 100 40 40 '("Tahoma" 10.2 0 0 0) "MC" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_26 5  25 150 40 40 '("Tahoma" 10.2 1 0 0) "<--" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_27 5 225 150 40 40 '("Tahoma" 10.2 0 0 0) "1/x" &HFFF3E8)
(dlgaddcontrol 'my-Dlg '_BUT_28 5 125 150 40 40 '("Tahoma" 10.2 0 0 0) "C" &HFFF3E8)
//***************************************************************************************
// Auxuliary Function.
(defun Pars (str)
  (input (strcat "(" (dlgGetText '_Txt_1) ")")))
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_1.
(defun _BUT_1_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) "1")))
 
// Назначение процедуры-события _BUT_1_Click  контролу _BUT_1.
(dlgSetEvent '_BUT_1 '_BUT_1_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_2.
(defun _BUT_2_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) "2")))
 
(dlgSetEvent '_BUT_2 '_BUT_2_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_3.
(defun _BUT_3_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) "0")))
 
(dlgSetEvent '_BUT_3 '_BUT_3_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_4.
(defun _BUT_4_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) ".")))
 
(dlgSetEvent '_BUT_4 '_BUT_4_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_5.
(defun _BUT_5_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) " + ")))
 
(dlgSetEvent '_BUT_5 '_BUT_5_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_6.
(defun _BUT_6_Click ()
  (prog (ch)
    (setq ch (pars (dlgGetText '_Txt_1)))
    (TRY
      (prog (res)
        (setq res (eval (inf2pref ch)))
        (setq res
             (if (floatp res) (format res "0.0#####") (format res "0")))
        (putprop '_TXT_1 'TEXT res))
     EXCEPT nil)))
 
(dlgSetEvent '_BUT_6 '_BUT_6_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_7.
(defun _BUT_7_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) " - ")))
 
(dlgSetEvent '_BUT_7 '_BUT_7_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_8.
(defun _BUT_8_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) "3")))
 
(dlgSetEvent '_BUT_8 '_BUT_8_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_9.
(defun _BUT_9_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) " * ")))
 
(dlgSetEvent '_BUT_9 '_BUT_9_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_10.
(defun _BUT_10_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) " / ")))
 
(dlgSetEvent '_BUT_10 '_BUT_10_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_11.
(defun _BUT_11_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) "4")))
 
(dlgSetEvent '_BUT_11 '_BUT_11_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_12.
(defun _BUT_12_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) "7")))
 
(dlgSetEvent '_BUT_12 '_BUT_12_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_13.
(defun _BUT_13_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) "5")))
 
(dlgSetEvent '_BUT_13 '_BUT_13_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_14.
(defun _BUT_14_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) "6")))
 
(dlgSetEvent '_BUT_14 '_BUT_14_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_15.
(defun _BUT_15_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) "8")))
 
(dlgSetEvent '_BUT_15 '_BUT_15_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_16.
(defun _BUT_16_Click () 
 (putprop '_TXT_1 'TEXT (strcat (dlgGetText '_Txt_1) "9")))
 
(dlgSetEvent '_BUT_16 '_BUT_16_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_17.
(defun _BUT_17_Click ()
  (prog (ch)
    (setq ch (car (pars (dlgGetText '_Txt_1))))
    (TRY
      (prog (res)
        (setq res (sqr ch))
        (setq res
             (if (floatp res) (format res "0.0#####") (format res "0")))
        (putprop '_TXT_1 'TEXT res))
     EXCEPT nil)))
 
(dlgSetEvent '_BUT_17 '_BUT_17_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_18.
(defun _BUT_18_Click ()
  (prog (ch)
    (setq ch (pars (dlgGetText '_Txt_1)))
    (TRY
      (prog (res)
        (setq res
              (funcall (cadr ch)
              (car ch)
              (* (car ch) (funcall '/ (caddr ch) 100))))
        (setq res
             (if (floatp res) (format res "0.0#####") (format res "0")))
        (putprop '_TXT_1 'TEXT res))
     EXCEPT nil)))
 
(dlgSetEvent '_BUT_18 '_BUT_18_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_19.
(defun _BUT_19_Click ()
  (putprop '_TXT_1 'TEXT ""))
 
(dlgSetEvent '_BUT_19 '_BUT_19_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_20.
(defun _BUT_20_Click () 
  (dlghide 'my-Dlg)
  (dlgDestroy 'my-Dlg)
  (gc))
 
// Назначение процедуры-события _BUT_20_Click  контролу _BUT_20.
(dlgSetEvent '_BUT_20 '_BUT_20_Click)
//-----------------------------------------------------------------------------
//Память калькулятора. Closure.
(let ((c 0))
  (defun M+ (num) (setq c (+ c num)))
  (defun M- (num) (setq c (- c num)))
  (defun MR () c)
  (defun MC () (setq c 0)))
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_21.
(defun _BUT_21_Click ()
  (prog (ch)
    (setq ch (car (pars (dlgGetText '_Txt_1))))
    (TRY
      (prog (res)
        (setq res (M- ch))
        (setq res
             (if (floatp res) (format res "0.0#####") (format res "0")))
        (putprop '_TXT_1 'TEXT res))
     EXCEPT nil)))
 
(dlgSetEvent '_BUT_21 '_BUT_21_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_22.
(defun _BUT_22_Click ()
  (prog (ch)
    (setq ch (car (pars (dlgGetText '_Txt_1))))
    (TRY
      (prog (res)
        (setq res (M+ ch))
        (setq res
             (if (floatp res) (format res "0.0#####") (format res "0")))
        (putprop '_TXT_1 'TEXT res))
     EXCEPT nil)))
 
(dlgSetEvent '_BUT_22 '_BUT_22_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_23.
(defun _BUT_23_Click ()
  (let ((res (car (input (strcat "(" (dlgGetText '_Txt_1) ")")))))
    (putprop '_TXT_1 'TEXT "")
    (putprop '_TXT_1 'TEXT (format (- 0 res) "0.0#####"))))
 
(dlgSetEvent '_BUT_23 '_BUT_23_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_24.
(defun _BUT_24_Click ()
 (putprop '_TXT_1 'TEXT (format (MR) "0.0#####")))
 
(dlgSetEvent '_BUT_24 '_BUT_24_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_25.
(defun _BUT_25_Click ()
 (MC))
 
(dlgSetEvent '_BUT_25 '_BUT_25_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_26.
(defun _BUT_26_Click ()
  (let ((prop (dlgGetText '_Txt_1)))
    (cond
      ((= 0 (strlen prop)) nil)
      ((= 1 (strlen prop)) (putprop '_TXT_1 'TEXT ""))
      (t (let* ((cur prop)
                (res (strmid cur 1 (- (strlen cur) 1))))
           (putprop '_TXT_1 'TEXT res))))))
 
(dlgSetEvent '_BUT_26 '_BUT_26_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_27.
(defun _BUT_27_Click ()
  (prog (ch)
    (setq ch (car (pars (dlgGetText '_Txt_1))))
    (TRY
      (prog (res)
        (setq res (funcall '/ 1.0 ch))
        (setq res
             (if (floatp res) (format res "0.0#####") (format res "0")))
        (putprop '_TXT_1 'TEXT res))
     EXCEPT nil)))
 
(dlgSetEvent '_BUT_27 '_BUT_27_Click)
//-----------------------------------------------------------------------------
//Обработчик события CLICK для кнопки _BUT_28.
(defun _BUT_28_Click ()
  (MC)
  (putprop '_TXT_1 'TEXT ""))
 
(dlgSetEvent '_BUT_28 '_BUT_28_Click)
//***************************************************************************************
// The Start of Dialogue.
(dlgShow 'my-Dlg)
 
) //end programm
  //(Calc)

@helter · 12.12.2013, 16:53

А-а-а, гуи - зло!!! А в макросы это можно завернуть? Или код сам собой порождается?

transformator.t · 12.12.2013, 17:06

Сообщение от helter

А-а-а, гуи - зло!!!

от чего же?

@Catstail · 12.12.2013, 17:11

Сообщение от helter

Или код сам собой порождается?

- порождается. Из дизайнера: Конструктор диалогов

Добавлено через 1 минуту

Сообщение от Lambdik

Есть вопросы:

- боюсь, что пока сказать нечего... Нужно дорабатывать.

@helter · 12.12.2013, 17:13

Не по теме:

Сообщение от transformator.t

от чего же?

Троллю, вестимо. :) Вручную описывать каждый чих (то есть клик) - тяжко. Ну раз порождается - другое дело.

@Catstail · 12.12.2013, 17:15

Lambdik, симпатично!!!

@Lambdik · 12.12.2013, 17:19 **[ТС]**

Специально вводил все вручную, чтобы получше записать на подкорку.

Добавлено через 1 минуту
Catstail
И еще вопрос.
Я так понял, что картинку загрузить нельзя. Например карту метро, с проделанными отверстиями под галочки?

@Catstail · 13.12.2013, 12:08

Сообщение от Lambdik

Я так понял, что картинку загрузить нельзя.

- поверх окна диалога, да нельзя... Но можно подумать в этом направлении.

Добавлено через 18 часов 22 минуты
Lambdik, кстати, Вы знаете, что такие приложения можно вызывать как скрипты? Если Вы установили HL в полном объеме, то должна присутствовать библиотека HomeLispLib.exe и зарегистрировано расширение ".li". Если это так, то переименовываете файл *.lsp -> *.li. Последний можно запускать двойным щелчком.

@Lambdik · 13.12.2013, 13:53 **[ТС]**

Сообщение от Catstail

переименовываете файл *.lsp -> *.li.

Спасибо, попробую!

Добавлено через 46 минут
Не получилось, пишет: Wlisp Скрипт Calc.li завершен.
Хотя библиотека HomeLispLib.exe есть, и все что я делал, это вызывал ее двойным щелчком.
Wlisp.exe аналогично.
Зато exe-шник создался, все как полагается.

@Catstail · 13.12.2013, 14:06

Сообщение от Lambdik

Не получилось, пишет: Wlisp Скрипт Calc.li завершен.

- я немного ошибся. У Вас в файле только (defun calc ...)? Нужно еще добавить вызов (calc)

@Lambdik · 13.12.2013, 14:37 **[ТС]**

Сообщение от Catstail

Нужно еще добавить вызов (calc)

Все равно не запускается.
Добавил (Calc) после всей программы. Нарушен баланс скобок: (Calc

Добавлено через 7 минут
Но все равно, если переносить на другой комп, то только исполняемый exe.
А скрипт это просто для мгновенного использования, так ведь?

@Catstail · 13.12.2013, 15:51

Сообщение от Lambdik

А скрипт это просто для мгновенного использования, так ведь?

- в общем да.

Добавлено через 37 секунд

Сообщение от Lambdik

Нарушен баланс скобок: (Calc

- а Вы после (calc) вставьте пару пустых строк

@Lambdik · 13.12.2013, 18:23 **[ТС]**

Catstail
Спасибо! Ели запустил. Пришлось еще заменить _BUTTON на 5, а _TEXT соответственно на 2.

@helter 4527 / 3521 / 358 Регистрация: 12.03.2013 Сообщений: 6,038
	12.12.2013, 16:53	2
	А-а-а, гуи - зло!!! А в макросы это можно завернуть? Или код сам собой порождается? 2

transformator.t defun 603 / 617 / 44 Регистрация: 30.04.2011 Сообщений: 702
	12.12.2013, 17:06	3
	Сообщение от helter А-а-а, гуи - зло!!! от чего же? 2

@Catstail Модератор 36601 / 20330 / 4220 Регистрация: 12.02.2012 Сообщений: 33,644 Записей в блоге: 13
	12.12.2013, 17:11	4
	Сообщение от helter Или код сам собой порождается? - порождается. Из дизайнера: Конструктор диалогов Добавлено через 1 минуту Сообщение от Lambdik Есть вопросы: - боюсь, что пока сказать нечего... Нужно дорабатывать. 2

@helter
	12.12.2013, 17:13 #5
	Не по теме: Сообщение от transformator.t от чего же? Троллю, вестимо. :) Вручную описывать каждый чих (то есть клик) - тяжко. Ну раз порождается - другое дело. 0

@Catstail Модератор 36601 / 20330 / 4220 Регистрация: 12.02.2012 Сообщений: 33,644 Записей в блоге: 13
	12.12.2013, 17:15	6
	Lambdik, симпатично!!! 1

@Lambdik 1050 / 944 / 107 Регистрация: 04.11.2012 Сообщений: 974 Записей в блоге: 3
	12.12.2013, 17:19 [ТС]	7
	Специально вводил все вручную, чтобы получше записать на подкорку. Добавлено через 1 минуту Catstail И еще вопрос. Я так понял, что картинку загрузить нельзя. Например карту метро, с проделанными отверстиями под галочки? 1

@Catstail Модератор 36601 / 20330 / 4220 Регистрация: 12.02.2012 Сообщений: 33,644 Записей в блоге: 13
	13.12.2013, 12:08	8
	Сообщение от Lambdik Я так понял, что картинку загрузить нельзя. - поверх окна диалога, да нельзя... Но можно подумать в этом направлении. Добавлено через 18 часов 22 минуты Lambdik, кстати, Вы знаете, что такие приложения можно вызывать как скрипты? Если Вы установили HL в полном объеме, то должна присутствовать библиотека HomeLispLib.exe и зарегистрировано расширение ".li". Если это так, то переименовываете файл .lsp -> .li. Последний можно запускать двойным щелчком. 1

@Lambdik 1050 / 944 / 107 Регистрация: 04.11.2012 Сообщений: 974 Записей в блоге: 3
	13.12.2013, 13:53 [ТС]	9
	Сообщение от Catstail переименовываете файл .lsp -> .li. Спасибо, попробую! Добавлено через 46 минут Не получилось, пишет: Wlisp Скрипт Calc.li завершен. Хотя библиотека HomeLispLib.exe есть, и все что я делал, это вызывал ее двойным щелчком. Wlisp.exe аналогично. Зато exe-шник создался, все как полагается. 0

@Catstail Модератор 36601 / 20330 / 4220 Регистрация: 12.02.2012 Сообщений: 33,644 Записей в блоге: 13
	13.12.2013, 14:06	10
	Сообщение от Lambdik Не получилось, пишет: Wlisp Скрипт Calc.li завершен. - я немного ошибся. У Вас в файле только (defun calc ...)? Нужно еще добавить вызов (calc) 1

@Lambdik 1050 / 944 / 107 Регистрация: 04.11.2012 Сообщений: 974 Записей в блоге: 3
	13.12.2013, 14:37 [ТС]	11
	Сообщение от Catstail Нужно еще добавить вызов (calc) Все равно не запускается. Добавил (Calc) после всей программы. Нарушен баланс скобок: (Calc Добавлено через 7 минут Но все равно, если переносить на другой комп, то только исполняемый exe. А скрипт это просто для мгновенного использования, так ведь? 0

	13.12.2013, 18:23

@Catstail Модератор 36601 / 20330 / 4220 Регистрация: 12.02.2012 Сообщений: 33,644 Записей в блоге: 13
	13.12.2013, 15:51	12
	Сообщение от Lambdik А скрипт это просто для мгновенного использования, так ведь? - в общем да. Добавлено через 37 секунд Сообщение от Lambdik Нарушен баланс скобок: (Calc - а Вы после (calc) вставьте пару пустых строк 1

@Lambdik 1050 / 944 / 107 Регистрация: 04.11.2012 Сообщений: 974 Записей в блоге: 3
	13.12.2013, 18:23 [ТС]	13
	Catstail Спасибо! Ели запустил. Пришлось еще заменить _BUTTON на 5, а _TEXT соответственно на 2. 0