github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-13 15:37:38 +00:00
Code Issues Projects Releases Wiki Activity

DMISC: Generalize argument to FLASHWINDOW

Browse Source
This commit is contained in:
rmkaplan 2022-01-24 21:07:01 -08:00
parent 1438ddba1f
commit 51f0c19ad1
2 changed files with 63 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

117
sources/DMISC
View File

@ -1,13 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-May-90 15:53:57" {DSK}<usr>local>lde>lispcore>sources>DMISC.;3 45292
changes to%: (VARS DMISCCOMS)
(FILECREATED " 6-Jan-2022 19:08:15" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DMISC.;3 45512
previous date%: " 6-Apr-90 10:59:19" {DSK}<usr>local>lde>lispcore>sources>DMISC.;2)
:CHANGES-TO (FNS FLASHWINDOW)
:PREVIOUS-DATE "16-May-90 15:53:57"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DMISC.;1)
(* ; "
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1982-1990 by Venue & Xerox Corporation.
The following program was created in 1982 but has not been published
within the meaning of the copyright law, is furnished under license,
and may not be used, copied and/or disclosed except in accordance
@ -41,7 +43,7 @@ with the terms of said license.
(DECLARE%: EVAL@COMPILE DONTCOPY (RESOURCES \PlayTimer))
(INITRESOURCES \PlayTimer)
(DECLARE%: DONTEVAL@LOAD DOCOPY (* ;
 "Overrides definition in the shared MISC")
 "Overrides definition in the shared MISC")
(P (MOVD 'RINGBELLS 'PRINTBELLS]
[COMS (* ; "Changing display")
(FNS DISPLAYDOWN SETDISPLAYHEIGHT VIDEORATE)
@ -68,7 +70,7 @@ with the terms of said license.
\MISC1.UFN \MISC2.UFN \MISC3.UFN \MISC4.UFN \MISC5.UFN \MISC6.UFN \MISC7.UFN
\MISC8.UFN \MISC10.UFN)
(* ;
 "sub-functions of floating-point ufns")
 "sub-functions of floating-point ufns")
(FNS \BLKFDIFF.UFN \BLKFPLUS.UFN \BLKFTIMES.UFN \BLKSEP.UFN \BLKPERM.UFN
\BLKEXPONENT.UFN \BLKFLOATP2COMP.UFN \BLKSMALLP2FLOAT.UFN \BLKMAG.UFN
\FLOATTOBYTE.UFN \BLKFMAX.UFN \BLKFMIN.UFN \BLKFABSMAX.UFN \BLKFABSMIN.UFN)
@ -79,7 +81,7 @@ with the terms of said license.
(LOCALVARS . T)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA \DIRTYBACKGROUND])
(LAMA])
(DEFINEQ
(BACKSPACEDEL
@ -226,28 +228,35 @@ with the terms of said license.
(FLASHWINDOW NIL N])
(FLASHWINDOW
[LAMBDA (WIN? N FLASHINTERVAL SHADE) (* bvm%: "16-Jul-85 12:20")
(* ; "This is an 'attention getting' action.")
(* ;
"rrb --- added shade argument so contrast of flash could be explored.")
[LAMBDA (WIN? N FLASHINTERVAL SHADE) (* ; "Edited 6-Jan-2022 19:08 by rmk")
(* bvm%: "16-Jul-85 12:20")
(* ;
 "This is an 'attention getting' action.")
(* ;
 "rrb --- added shade argument so contrast of flash could be explored.")
(OR (FIXP N)
(SETQ N 1))
(OR (FIXP FLASHINTERVAL)
(SETQ FLASHINTERVAL 200))
[COND
((WINDOWP WIN?)
(SETQ WIN? (GETSTREAM WIN? 'OUTPUT]
(WIN?
(* ;;
 "RMK: GETSTREAM even if not a window. Catches T, other streams. But NIL still means whole screen")
(SETQ WIN? (GETSTREAM WIN? 'OUTPUT]
(for I to N bind (WHOLEP _ (NOT (DISPLAYSTREAMP WIN?)))
COLORP first [COND
(WHOLEP (SETQ COLORP (NULL (VIDEOCOLOR]
do (UNINTERRUPTABLY
(* ;
"Open-coded 'during' loops so that no one else can sneak in and steal cycles")
(* ;
 "Open-coded 'during' loops so that no one else can sneak in and steal cycles")
(COND
[WHOLEP (* ; "Flash the whole screen")
[WHOLEP (* ; "Flash the whole screen")
(VIDEOCOLOR (PROG1 (VIDEOCOLOR COLORP)
(DISMISS FLASHINTERVAL NIL T]
(T (* ;; "Although VIDEOCOLOR is nearly instantaneous, INVERTW may require a time approaching the interval time and thus this path could be much longer")
(T
(* ;; "Although VIDEOCOLOR is nearly instantaneous, INVERTW may require a time approaching the interval time and thus this path could be much longer")
(INVERTW WIN? SHADE)
(DISMISS FLASHINTERVAL NIL T)
(INVERTW WIN? SHADE))))
@ -907,26 +916,26 @@ with the terms of said license.
)
(RPAQQ RINGBELLS.L1 ((1000 . 1000)
(800 . 1000)
(600 . 1000)
(500 . 1000)
(400 . 1000)
(NIL . 500)
(440 . 1000)
(484 . 1000)
(540 . 1000)
(600 . 1000)))
(800 . 1000)
(600 . 1000)
(500 . 1000)
(400 . 1000)
(NIL . 500)
(440 . 1000)
(484 . 1000)
(540 . 1000)
(600 . 1000)))
(RPAQQ RINGBELLS.L2 ((2000 . 1000)
(1600 . 1000)
(1200 . 1000)
(1000 . 1000)
(800 . 1000)
(NIL . 500)
(880 . 1000)
(968 . 1000)
(1080 . 1000)
(1188 . 1000)))
(1600 . 1000)
(1200 . 1000)
(1000 . 1000)
(800 . 1000)
(NIL . 500)
(880 . 1000)
(968 . 1000)
(1080 . 1000)
(1188 . 1000)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
@ -937,27 +946,27 @@ with the terms of said license.
(ADDTOVAR NLAML )
(ADDTOVAR LAMA \DIRTYBACKGROUND)
(ADDTOVAR LAMA )
)
(PUTPROPS DMISC COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4791 5494 (BACKSPACEDEL 4801 . 5492)) (5589 6022 (PERIODICALLYRECLAIM 5599 . 6020)) (
6252 7943 (\DIRTYBACKGROUND 6262 . 6684) (\SAVEVMBACKGROUND 6686 . 7470) (COPYVM 7472 . 7941)) (8364
9563 (SETTIME 8374 . 9561)) (9564 13243 (RINGBELLS 9574 . 10067) (FLASHWINDOW 10069 . 11645) (PLAYTUNE
11647 . 13241)) (13505 19037 (DISPLAYDOWN 13515 . 13903) (SETDISPLAYHEIGHT 13905 . 16705) (VIDEORATE
16707 . 19035)) (19461 20182 (DOAROUNDEXITFORMS 19471 . 20180)) (20385 22100 (REALMEMORYSIZE 20395 .
20553) (LISPVERSION 20555 . 20708) (MICROCODEVERSION 20710 . 20868) (BCPLVERSION 20870 . 21023) (
REQUIREVERSION 21025 . 22098)) (22137 26715 (APROPOS 22147 . 26163) (APROPRINT 26165 . 26713)) (26741
30649 (READPRINTERPORT 26751 . 26892) (WRITEPRINTERPORT 26894 . 27049) (\READPRINTERPORT.UFN 27051 .
27240) (\WRITEPRINTERPORT.UFN 27242 . 27440) (\MISC1.UFN 27442 . 27595) (\MISC2.UFN 27597 . 27835) (
\MISC3.UFN 27837 . 28570) (\MISC4.UFN 28572 . 29122) (\MISC5.UFN 29124 . 29277) (\MISC6.UFN 29279 .
29529) (\MISC7.UFN 29531 . 30016) (\MISC8.UFN 30018 . 30319) (\MISC10.UFN 30321 . 30647)) (30703 38152
(\BLKFDIFF.UFN 30713 . 31278) (\BLKFPLUS.UFN 31280 . 31852) (\BLKFTIMES.UFN 31854 . 32429) (
\BLKSEP.UFN 32431 . 33562) (\BLKPERM.UFN 33564 . 34033) (\BLKEXPONENT.UFN 34035 . 34445) (
\BLKFLOATP2COMP.UFN 34447 . 35031) (\BLKSMALLP2FLOAT.UFN 35033 . 35392) (\BLKMAG.UFN 35394 . 36045) (
\FLOATTOBYTE.UFN 36047 . 36626) (\BLKFMAX.UFN 36628 . 37020) (\BLKFMIN.UFN 37022 . 37411) (
\BLKFABSMAX.UFN 37413 . 37782) (\BLKFABSMIN.UFN 37784 . 38150)) (38192 40010 (\P-MISC2.UFN 38202 .
38443) (\LINES-EQUAL-P 38445 . 38829) (\GET-NEXT-RUN 38831 . 40008)) (40011 44190 (IBLT1 40021 . 42023
) (IBLT2 42025 . 44188)))))
(FILEMAP (NIL (4747 5450 (BACKSPACEDEL 4757 . 5448)) (5545 5978 (PERIODICALLYRECLAIM 5555 . 5976)) (
6208 7899 (\DIRTYBACKGROUND 6218 . 6640) (\SAVEVMBACKGROUND 6642 . 7426) (COPYVM 7428 . 7897)) (8320
9519 (SETTIME 8330 . 9517)) (9520 13551 (RINGBELLS 9530 . 10023) (FLASHWINDOW 10025 . 11953) (PLAYTUNE
11955 . 13549)) (13813 19345 (DISPLAYDOWN 13823 . 14211) (SETDISPLAYHEIGHT 14213 . 17013) (VIDEORATE
17015 . 19343)) (19769 20490 (DOAROUNDEXITFORMS 19779 . 20488)) (20693 22408 (REALMEMORYSIZE 20703 .
20861) (LISPVERSION 20863 . 21016) (MICROCODEVERSION 21018 . 21176) (BCPLVERSION 21178 . 21331) (
REQUIREVERSION 21333 . 22406)) (22445 27023 (APROPOS 22455 . 26471) (APROPRINT 26473 . 27021)) (27049
30957 (READPRINTERPORT 27059 . 27200) (WRITEPRINTERPORT 27202 . 27357) (\READPRINTERPORT.UFN 27359 .
27548) (\WRITEPRINTERPORT.UFN 27550 . 27748) (\MISC1.UFN 27750 . 27903) (\MISC2.UFN 27905 . 28143) (
\MISC3.UFN 28145 . 28878) (\MISC4.UFN 28880 . 29430) (\MISC5.UFN 29432 . 29585) (\MISC6.UFN 29587 .
29837) (\MISC7.UFN 29839 . 30324) (\MISC8.UFN 30326 . 30627) (\MISC10.UFN 30629 . 30955)) (31011 38460
(\BLKFDIFF.UFN 31021 . 31586) (\BLKFPLUS.UFN 31588 . 32160) (\BLKFTIMES.UFN 32162 . 32737) (
\BLKSEP.UFN 32739 . 33870) (\BLKPERM.UFN 33872 . 34341) (\BLKEXPONENT.UFN 34343 . 34753) (
\BLKFLOATP2COMP.UFN 34755 . 35339) (\BLKSMALLP2FLOAT.UFN 35341 . 35700) (\BLKMAG.UFN 35702 . 36353) (
\FLOATTOBYTE.UFN 36355 . 36934) (\BLKFMAX.UFN 36936 . 37328) (\BLKFMIN.UFN 37330 . 37719) (
\BLKFABSMAX.UFN 37721 . 38090) (\BLKFABSMIN.UFN 38092 . 38458)) (38500 40318 (\P-MISC2.UFN 38510 .
38751) (\LINES-EQUAL-P 38753 . 39137) (\GET-NEXT-RUN 39139 . 40316)) (40319 44498 (IBLT1 40329 . 42331
) (IBLT2 42333 . 44496)))))
STOP

BIN
sources/DMISC.LCOM
View File

Binary file not shown.