Tk (or other) GUI in newLisp (single executable)
Posted: Thu Nov 24, 2016 9:18 pm
how to make it?
without Java runtime environment
without Java runtime environment
Friends and Fans of newLISP
http://www.newlispfanclub.alh.net/forum/
http://www.newlispfanclub.alh.net/forum/viewtopic.php?f=10&t=4863
HPW wrote:
My version from 2011 was posted here:
viewtopic.php?f=9&t=3902&p=19367&hilit= ... zip#p19367
However I still run a version with the current newlisp version but build not with freewrap as the 2011 version,
instead I use the TCL basekit 8.5.14 from Active State in 2015.
http://www.hpwsoft.de/anmeldung/html1/n ... ptk_85.zip
Regards
It is a combination of 2 exe. Tcl/tk and the normal newlisp.exeCan you explain how it works? Is it an exe that combines tcl/tk and newlisp into one binary,
Code: Select all
set Ide(imageDir) "TclApp"
Code: Select all
;;;;
;;;; Module 'tk'
;;;; newLISP + tk ('runtk' légèrement modifié - avril 2015)
;;;;
;;;; d'après runtk v 1.4 updated for 10.1 LM Nov 27th, 2009
;;;; original version by Fanda:
;;;; http://www.intricatevisions.com/index.cgi?page=newlisp
;;;; Run programs written for newlisp-tk without without it
;;;; Only newLISP and a installation of Tcl/Tk is required.
;;;;
;;;; - faire (load "tk") en tête de script
;;;; - écrire les commandes Tk à l'aide de la fonction (tk ...) qui accepte
;;;; des chaîne de caractères comme arguments (arguments of 'tk' are strings)
;;;; - ajouter (tk-mainloop) en fin de script (event loop)
;;;;
;;; Installer les communications avec Tcl/Tk
(map set '(myin tcout) (pipe))
(map set '(tcin myout) (pipe))
(process "/usr/bin/wish" tcin tcout)
;;; La fonction 'tk' envoie des commandes à Tcl/Tk et retourne les erreurs éventuelles
(define (tk)
(write-line myout (append "if { [catch { puts ["
(apply string (args)) "] }] } { "
[text] tk_messageBox -message $errorInfo; exit }
[/text]))
(let (str "")
(while (starts-with (setq str (read-line myin)) "newLISP:")
(eval-string ((length "newLISP: ") -1 str)))
str))
(global 'tk)
;;; Sortir à la fermeture de la fenêtre principale
(tk "bind . <Destroy> {puts {(exit)}}")
;;; Boucle événementielle qui traite les requêtes entrantes de newLISP
(define (tk-mainloop)
(while (read-line myin)
(eval-string (current-line))))
;;; NB : il faut ajouter cette fonction à la fin d'un script "newLISP-tk"
Code: Select all
(load "tk")
;;; Variables globales
(set 'x1 2 'y1 2)
(set 'x2 (+ x1 40) 'y2 (+ y1 40))
(set 'dx 8 'dy 0)
(set 'coor (string " " x1 " " y1 " " x2 " " y2 " "))
(set 'commut 0)
;;; Procédures gérant les événements
(define (arreter)
;; arrêter l'animation
(setq commut 0))
(define (demarrer)
;; démarrer l'animation
(++ commut)
(if (= commut 1) (animer)))
(define (quitter)
;; quitter Tk et newLISP
(tk "exit")
(exit))
;;; Procédure principale
(define (animer)
;; déplacer la balle
(setq x1 (+ x1 dx) y1 (+ y1 dy))
(setq x2 (+ x1 40) y2 (+ y1 40))
(setq coor (string " " x1 " " y1 " " x2 " " y2 " "))
(if (> x1 360)
(setq x1 360 dx 0 dy 8))
(if (> y1 360)
(setq y1 360 dx (- 8) dy 0))
(if (< x1 2)
(setq x1 2 dx 0 dy (- 8)))
(if (< y1 2)
(setq y1 2 dx 8 dy 0))
(tk ".canevas coords " balle coor)
(if (> commut 0)
(tk "after 20 {puts (animer)}")))
;;;
;;; Programme principal
;;;
(tk "wm title . {Animation with newLISP & tk}
wm geometry . +200+200
. configure -background DarkGrey")
(tk "canvas .canevas -bg snow -height 400 -width 400
pack .canevas -side left -padx 4 -pady 4")
;; Créer et afficher la forme (balle rouge)
(setq balle
(tk ".canevas create oval " coor " -width 1 -fill red"))
;; Créer et placer les boutons de commande
(setq style
(join '(" -width 10"
" -background RoyalBlue4"
" -foreground white"
" -activebackground RoyalBlue4"
" -activeforeground orange"
" -font {arial 10 bold}"))) ; ‘style’ des boutons
(tk "button .demarrer -text Start -command {puts (demarrer)}" style)
(tk "button .arreter -text Stop -command {puts (arreter) }" style)
(tk "button .quitter -text Quit -command {puts (quitter) }" style)
(tk "pack .demarrer .arreter -padx 4 -pady 4")
(tk "pack .quitter -side bottom -padx 4 -pady 4")
;;;
;;; Scruter les requêtes entrantes de newLISP (boucle Tk)
;;;
(tk-mainloop)