home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2XLSP1.ZIP / WELCOME.LSP < prev   
Text File  |  1988-07-19  |  6KB  |  190 lines
  1. ; welcome.lsp
  2. ; Andrew Schulman 24-Feb-1988 (revised 15-Mar-88)
  3. ; (revised 17-Apr-88:  VIOPOPUP)
  4. ; for OS/2 XLISP
  5.  
  6. ; get the addresses of the OS/2 functions
  7. (define vio-wrt-char-str-att (getprocaddr viocalls "VIOWRTCHARSTRATT"))
  8. (define vio-scroll-dn (getprocaddr viocalls "VIOSCROLLDN"))
  9. (define kbd-char-in (getprocaddr kbdcalls "KBDCHARIN"))
  10.             
  11. (define w0 (word 0))            
  12.             
  13. ;;; an example of higher-level access to the OS/2 functions
  14. (define (vio-wrt msg row col attr)
  15.     (call
  16.         vio-wrt-char-str-att
  17.         msg                             ; same as (addr msg)
  18.         (word (length msg))
  19.         (makelong row col)
  20.         (addr (word attr))
  21.         w0))
  22.  
  23. (define (wait)
  24.     (call
  25.         kbd-char-in
  26.         (make-string 32 10)                  ; we're ignoring input data
  27.         w0                                   ; wait for the character
  28.         w0))
  29.  
  30. ;;; clear an area of the screen
  31. (define (clear top left bottom right)
  32.     (call
  33.         vio-scroll-dn
  34.         (word top) (word left)
  35.         (word bottom) (word right)
  36.         (word -1)
  37.         (addr (word 32))
  38.         w0))
  39.  
  40. ;;; "sprintf" some data into a string
  41. (define (whoami)
  42.     (format nil "PID ~A, THREAD ~A, GROUP ~A"
  43.         (getpid)
  44.         (thread-id)
  45.         (getgrp)))
  46.             
  47. (define (who-is-foreground)
  48.     (format nil "Foreground PID ~A, Foreground Group ~A"
  49.         (foreground-pid)
  50.         (foreground-session)))
  51.             
  52. ;;; make string of duplicated characters -- uses (repeat) macro in INIT.LSP
  53. ;;; this is a little slow now; to make (border) faster, it should be optimized
  54. ;;; cf. Steele, p.302
  55. ;(define (make-string n ch)
  56. ;   (let
  57. ;       ((str1 "") (str2 (string (int-char ch))))
  58. ;       (repeat n 
  59. ;           (define str1
  60. ;               (strcat str1 str2)))
  61. ;       str1))
  62. ; forget preceding - now an OS2XLISP built-in
  63.             
  64. ;;; make a border
  65. (define (border top left bottom right)
  66.     (let ((tmp *word-format*))
  67.         (define *word-format* nil)          
  68.         (clear top left bottom right)
  69.         (vio-wrt
  70.             (format nil "~A~A~A"
  71.                 (int-char 201)              ; top left
  72.                 (make-string
  73.                     (int-char 205)          ; top row
  74.                     (- right left 1))       ; note triple subtraction
  75.                 (int-char 187))             ; top right
  76.             top left 10)
  77.         (let
  78.             ((e (string (int-char 186))))
  79.             (dotimes
  80.                 (i (- bottom top 1))
  81.                 (vio-wrt e (+ top 1 i) left 10)     ; left edge
  82.                 (vio-wrt e (+ top 1 i) right 10)))  ; right edge
  83.         (vio-wrt
  84.             (format nil "~A~A~A"
  85.                 (int-char 200)                  ; bottom left
  86.                 (make-string
  87.                     (int-char 205)              ; bottom row
  88.                     (- right left 1))
  89.                 (int-char 188))                 ; bottom right
  90.             bottom left 10)
  91.         (define *word-format* tmp)))
  92.         
  93. ; clear the screen
  94. (clear 0 0 25 80)
  95. ;(border 0 0 24 79)
  96.  
  97. (dotimes
  98.     (i 400)
  99.     (vio-wrt "Welcome to OS/2 XLISP!" (rem i 24) (random 79) i))
  100. (vio-wrt (whoami) 14 25 10)     
  101.         
  102. ; make a little pop-up
  103. ; note that this operates in a different screen group, and will pop up
  104. ; over whatever is on the screen, even if OS2XLISP is running in the
  105. ; background
  106.  
  107. ;;; NOTE! if somehow welcome.lsp breaks between the VIOPOPUP and the
  108. ;;; VIOENDPOPUP, you won't be able to switch away.  To release the popup,
  109. ;;; just type at the OS2XLISP prompt:
  110. ;;; > (call (getprocaddr viocalls "VIOENDPOPUP") w0)
  111.  
  112. (call 
  113.     (getprocaddr viocalls "VIOPOPUP")
  114.     (addr (word 3))
  115.     w0)
  116. (border 3 20 12 56)
  117. (vio-wrt "         OS2XLISP Pop-up        " 4 22 10)
  118. (vio-wrt "    Press any key to continue   " 6 22 10)
  119. (vio-wrt "Note that the speed isn't so bad" 8 22 10)
  120. (vio-wrt "even though this is interpreted." 9 22 10)
  121. (vio-wrt (whoami) 11 25 10)
  122.  
  123. ; wait for a keystroke, restore the screen, then wait a sec
  124. (wait)
  125. (call
  126.     (getprocaddr viocalls "VIOENDPOPUP")        ; this operation is very fast!
  127.     w0)
  128. (call 
  129.     (getprocaddr doscalls "DOSSLEEP")           ; sleep a second
  130.     1000)
  131.  
  132. ;;; 
  133. ;;; ANSI FUNCTIONS
  134. ;;;
  135. (define (rev s)
  136.     (format stdout "\033[7m~A\033[0m~%" s))
  137.         
  138. (define (set-cursor row col)
  139.     (format stdout "\033[~A;~AH" row col))
  140.  
  141. (define (cls)
  142.     (princ "\033[2J")
  143.     nil)
  144.         
  145. ;;;
  146. ;;; SCREEN SET-UP
  147. ;;;
  148. (cls)
  149. (rev "Runtime Dynamic Linking with OS2XLISP\n")
  150.  
  151. (define (help)
  152.     '(date time elapsed-time vers foreground-session foreground-pid
  153.     boot-drive getpid getppid getgrp priority thread-id subsession
  154.     foreground? protect-only? present? code? dos-alloc-seg dos-free-seg
  155.     register dos-mem-avail cls))
  156.  
  157. ;;;
  158. ;;; DISPLAY
  159. ;;;
  160. (define (pr p) (format stdout "~A~%" p))
  161.  
  162. (pr "Now that DOSGETINFOSEG has been called, the following new XLISP")
  163. (pr "functions can be called.  These have all been implemented in INIT.LSP")
  164. (pr "using (loadmodule), (getprocaddr), and (peek) :")
  165. (print (help))
  166.  
  167. ;;;
  168. ;;; PRINT SOME STATISTICS
  169. ;;;
  170. (format stdout
  171.     "~%Date: ~A/~A/~A~%Time: ~A:~A:~A~%"
  172.     (first (date)) (second (date)) (third (date))
  173.     (first (time)) (second (time)) (third (time)))
  174. (format stdout
  175.     "~%Process-id: ~A~%Session: ~A~%"
  176.     (getpid)
  177.     (getgrp))
  178. (format stdout "~%OS2XLISP is running in the ~A~%"
  179.     (if (foreground?)
  180.         "foreground"
  181.         "background"))
  182. (if (not (foreground?))
  183.     (princ (who-is-foreground)))
  184. (format stdout
  185.     "~%MS-DOS real-mode ~A present~%"
  186.     (if (protect-only?) "is not" "is"))
  187. (format stdout
  188.     "~%Available memory: ~A~%"
  189.     (dos-mem-avail))
  190.