home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / forth / fifth.arc / WINDOW.FIV < prev   
Text File  |  1986-03-30  |  2KB  |  141 lines
  1. CREATE WINDOW
  2. CREATE SCROLL
  3. EDIT
  4. : scroll
  5.   0 0        \ es:ds si:di
  6.   4 pick 8 shl     \ dh
  7.   6 pick + 8 shl   \ dl
  8.   7 pick + 8 shl   \ ch
  9.   8 pick +         \ cl
  10.   4 pick 16 shl    \ bh bl->0
  11.   4 pick 0< if 7 + 8 shl 4 pick negate +
  12.             else 6 + 8 shl 4 pick +    endif
  13.   16 int
  14.   drop drop drop drop drop
  15.   drop drop drop drop drop drop
  16.   ;
  17. ~UP
  18. CREATE W1COLOR
  19. EDIT
  20. 31 constant w1color
  21. ~UP
  22. CREATE W2COLOR
  23. EDIT
  24. 79 constant w2color
  25. ~UP
  26. CREATE W3COLOR
  27. EDIT
  28. 121 constant w3color
  29. ~UP
  30. CREATE W1SCRL
  31. EDIT
  32. : w1scrl
  33.   1 1 38 10 w1color 1 scroll
  34. ;
  35. ~UP
  36. CREATE W2SCRL
  37. EDIT
  38. : w2scrl
  39.   41 1 78 10 w2color 1 scroll
  40.  ;
  41. ~UP
  42. CREATE W3SCRL
  43. EDIT
  44. : w3scrl
  45.   1 13 78 22 w3color -1 scroll
  46.  ;
  47. ~UP
  48. CREATE WINDOWS
  49. CREATE ULCORN
  50. EDIT
  51. 201 constant ulcorn
  52. ~UP
  53. CREATE URCORN
  54. EDIT
  55. 187 constant urcorn
  56. ~UP
  57. CREATE LLCORN
  58. EDIT
  59. 200 constant llcorn
  60. ~UP
  61. CREATE LRCORN
  62. EDIT
  63. 188 constant lrcorn
  64. ~UP
  65. CREATE HSIDE
  66. EDIT
  67. 205 constant hside
  68. ~UP
  69. CREATE VSIDE
  70. EDIT
  71. 186 constant vside
  72. ~UP
  73. CREATE WBOX
  74. EDIT
  75. : wbox
  76.   5 pick 5 pick 5 pick 5 pick 5 pick 0 scroll
  77.   5 pick 5 pick gotoxy ulcorn emit
  78.   3 pick 6 pick - 1- 0 do hside emit loop
  79.   urcorn emit
  80.   2 pick 5 pick - 1- 5 pick + 1+ 5 pick 1+
  81.    do
  82.       5 pick i gotoxy vside emit
  83.       3 pick i gotoxy vside emit
  84.    loop
  85.   5 pick 3 pick gotoxy llcorn emit
  86.   3 pick 6 pick - 1- 0 do hside emit loop
  87.   lrcorn emit
  88.   drop drop drop drop drop drop
  89. ;
  90. ~UP
  91. EDIT
  92. : windows
  93.   0  0 39 11 w1color 0 wbox
  94.   40 0 79 11 w2color 0 wbox
  95.   0 12 79 23 w3color 0 wbox
  96.   ;
  97. ~UP
  98. CREATE SAVEAREA
  99. EDIT
  100. create savearea 4000 allot
  101. ~UP
  102. CREATE SAVEIT
  103. EDIT
  104. : saveit
  105.   screen savearea 4000 cmove
  106. ;
  107. ~UP
  108. CREATE RESTOREIT
  109. EDIT
  110. : restoreit
  111.   savearea screen 4000 cmove
  112. ;
  113. ~UP
  114. CREATE WINDOWDEMO
  115. EDIT
  116. : windowdemo
  117.   saveit
  118.   windows
  119.   100 0 do
  120.     1 10 gotoxy
  121.     ."   Line " i .
  122.     ." This window is window 1"
  123.     w1scrl
  124.     41 10 gotoxy
  125.     ."   Line " i .
  126.     ." This window is window 2"
  127.     w2scrl
  128.     1 13 gotoxy
  129.     ."   Line " i .
  130.     ." This is window 3 this is window 3 this is window 3 this is window 3"
  131.     w3scrl
  132.     ?term if restoreit 0 23 gotoxy abort endif
  133.   loop
  134.   restoreit
  135.   0 23 gotoxy abort
  136.   ;
  137. ~UP
  138. EDIT
  139. : window windowdemo ;
  140. ~UP
  141. ABORT